home *** CD-ROM | disk | FTP | other *** search
/ Business Assistant / Business Assistant.iso / acctg / bf018 / payroll.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-11-26  |  45.5 KB  |  525 lines
  1. 10  CLS:KEY 8, "@"
  2. 30  COLOR 0,7:PRINT TAB(10)"REMOVE PROGRAM DISK FROM DRIVE  A  AND INSERT  PAYROLL DISK.":PRINT:PRINT TAB(10)"CURRENT EXPENSE FILE DISK MUST BE IN DRIVE B.":PRINT:PRINT TAB(10)"READY PRINTER.":PRINT:PRINT TAB(10) "PRESS  F8  WHEN READY.":COLOR 7,0
  3. 40  X$=INKEY$:IF X$<>"@" THEN 40
  4. 50  CLS:CLEAR,,1536:PRINT TAB(5) "CHOOSE":PRINT:ON ERROR GOTO 7000
  5. 55  FOR N=1 TO 10:KEY N,"":NEXT:KEY 8, "@":DL$="$$######.##":MODE$=CHR$(27)+CHR$(45)+CHR$(1)+CHR$(27)+CHR$(71)+CHR$(27)+CHR$(78)+CHR$(6):DEFDBL A-Z:DEFINT N,I,J:XMOD$=CHR$(27)+CHR$(45)+CHR$(0)+CHR$(27)+CHR$(72):PAYROLL=1:OPEN "A:EMPLOYEE.CNT" AS 2
  6. 140  FIELD 2, 20 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$
  7. 160  PRINT TAB(10) "W=WEEKLY PAYROLL (AUTOMATIC)":PRINT:PRINT TAB(10) "I=PAY INDIVIDUAL (MANUAL)":PRINT:PRINT TAB(10)"M=END MONTH (QUARTER AND YEAR ALSO IF LAST MONTH OF EITHER)":PRINT:PRINT TAB(10)"O=RETURN TO EXPENSE PROGRAM OPTIONS
  8. 170  PRINT:PRINT TAB(10)"E=CREATE,READ,REVISE EMPLOYEE DATA FILE":PRINT:PRINT TAB(10)"D=CREATE,READ,REVISE PAYROLL DEDUCTIONS FILE":PRINT:PRINT TAB(10)"R=READ PAYROLL FILE":PRINT:PRINT:PRINT TAB(10)"F=PREPARE NEW FILE DISKS (NOT IF FIRST USE OF SYSTEM)"
  9. 175  PRINT:PRINT TAB(10) "B=ALPHABETIZE EMPLOYEE LIST"
  10. 180  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):POKE 23, (PEEK(23) OR 32)
  11. 200  IF X$="W" OR X$="I" THEN 2840 ELSE IF X$="M" THEN FL$="CHKDSC":GOSUB 30210:CLOSE 4:BKUP=0:GOTO 2840 ELSE IF X$="O" THEN 30000 ELSE IF X$="E" THEN 240 ELSE IF X$="D" THEN 8000 ELSE IF X$="R" THEN 2920 ELSE IF X$="F" THEN 7300
  12. 210  IF X$="B" THEN 50000 ELSE 180
  13. 240  CLS:PRINT:PRINT TAB(10) "A=REHIRE EMPLOYEE WHO HAS ALREADY WORKED IN THIS CALENDER YEAR":PRINT:PRINT TAB(10) "N=HIRE NEW EMPLOYEEE":PRINT:PRINT TAB(10) "R=READ OR REVISE EMPLOYEE'S FILE OR DELETE EMPLOYEE"
  14. 260  EMD$=INKEY$:IF EMD$="" THEN 260
  15. 280  DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF EMD$="A" THEN PRINT:PRINT "AFTER READING EMPLOYEE DATA ON FILE FOR THIS EMPLOYEE, REVISE DATA AS NECESSARY. PRESS  F8 TO CONTINUE.":GOTO 300 ELSE 310
  16. 300  X$=INKEY$:IF X$<>"@" THEN 300 ELSE 1490
  17. 310  IF EMD$="R" THEN 1490 ELSE IF EMD$="N" THEN ES$="CURRENT":GOSUB 320:GOTO 400 ELSE 260
  18. 320  CLS
  19. 330  PRINT "ENTER EMPLOYEE'S LAST NAME       ";:INLN%=20:GOSUB 20050:NAM2$=INPT$:PRINT "ENTER EMPLOYEE'S FIRST NAME      ";:INLN%=15:GOSUB 20050:NAM1$=INPT$:PRINT "ENTER EMPLOYEE'S MIDDLE INITIAL  ";:INLN%=2:GOSUB 20050:MDL$=LEFT$(INPT$,1)+".":RETURN
  20. 400  PRINT "ENTER STREET ADDRESS OR BOX NO.  ";:INLN%=35:GOSUB 20050:ADR$=INPT$:IF REC1 THEN RETURN
  21. 430  PRINT "ENTER CITY,STATE,ZIP             ";:INLN%=35:GOSUB 20050:CITY$=INPT$:IF REC1 THEN RETURN
  22. 460  PRINT "ENTER PHONE NUMBER               ";:INLN%=13:GOSUB 20050:PHN$=INPT$:IF REC1 THEN RETURN
  23. 490  PRINT "ENTER SOCIAL SECURITY NUMBER     ";:INLN%=15:GOSUB 20050:SS$=INPT$:IF REC2 THEN RETURN
  24. 520  PRINT "ENTER PROFESSIONAL LIC. NO.      ";:INLN%=15:GOSUB 20050:PRF$=INPT$:IF REC2 THEN RETURN
  25. 550  PRINT "ENTER DRIVERS LICENSE NUMBER     ";:INLN%=15:GOSUB 20050:DRV$=INPT$:IF REC2 THEN RETURN
  26. 580  PRINT "ENTER START DATE                 ";:INLN%=8:GOSUB 20050:SD$=INPT$:IF REC2 THEN RETURN
  27. 610  PRINT "ENTER M IF MARRIED S IF SINGLE   ";:INLN%=1:GOSUB 20050:MAR$=INPT$:IF MAR$<>"M" AND MAR$<>"S" THEN PRINT "          PLEASE ENTER M OR S ONLY":GOTO 610
  28. 640  IF REC2 THEN RETURN
  29. 650  PRINT "ENTER EXEMPTIONS CLAIMED         ";:NBR=1:INLN%=2:GOSUB 20050:EXM%=VAL(INPT$):NBR=0:IF REC2 THEN EM%=1:RETURN
  30. 680  PRINT "ENTER S IF SALARY H IF HOURLY    ";:INLN%=1:GOSUB 20050:RAT$=INPT$:IF RAT$<>"S" AND RAT$<>"H" THEN PRINT "          PLEASE ENTER H OR S ONLY":GOTO 680
  31. 710  IF REC2 THEN RETURN
  32. 720  PRINT "ENTER WEEKLY OR HOURLY RATE      ";:NBR=1:INLN%=7:GOSUB 20050:SAL=VAL(INPT$):NBR=0:IF REC2 THEN SL%=1:RETURN
  33. 750  PRINT "ENTER EMPLOYEE NUMBER IF NEEDED.                                                       JUST PRESS ENTER IF NONE. ";:INLN%=6:GOSUB 20050:ENO$=INPT$:IF REC2 THEN RETURN
  34. 780  PRINT "ENTER TYPE OF 1ST MISC. DEDUCT.                                                        JUST PRESS ENTER IF NONE. ";:INLN%=15:GOSUB 20050:MIS1$=INPT$:IF REC3 THEN 820
  35. 810  IF MIS1$="" THEN MIS1=0:MIS2=0:MIS3=0:GOTO 990
  36. 820  PRINT "ENTER AMT. OF 1ST MISC. DEDUCT.  ";:NBR=1:INLN%=7:GOSUB 20050:MIS1=VAL(INPT$):NBR=0:IF REC3 THEN RETURN
  37. 850  PRINT "ENTER TYPE OF 2ND MISC. DEDUCT.                                                        JUST PRESS ENTER IF NONE. ";:INLN%=15:GOSUB 20050:MIS2$=INPT$:IF REC3 THEN 890
  38. 880  IF MIS2$="" THEN MIS2=0:MIS3=0:GOTO 990
  39. 890  PRINT "ENTER AMT. OF 2ND MISC. DEDUCT.  ";:NBR=1:INLN%=7:GOSUB 20050:MIS2=VAL(INPT$):NBR=0:IF REC3 THEN RETURN
  40. 920  PRINT "ENTER TYPE OF 3RD MISC. DEDUCT.                                                        JUST PRESS ENTER IF NONE. ";:INLN%=15:GOSUB 20050:MIS3$=INPT$:IF REC3 THEN 960
  41. 950  IF MIS3$="" THEN MIS3=0:GOTO 990
  42. 960  PRINT "ENTER AMT. OF 3RD MISC. DEDUCT.  ";:NBR=1:INLN%=7:GOSUB 20050:MIS3=VAL(INPT$):NBR=0:IF REC3 THEN RETURN
  43. 990  PRINT "ENTER 1 FOR REGULAR FED. WITHHOLD.                                              ENTER PERCENT IF FIXED PERCENT.                                                 ENTER 0 IF EXEMPT.                  ";
  44. 1000  NBR=1:INLN%=6:GOSUB 20050:FWITH=VAL(INPT$):NBR=0:IF REC3 THEN FW%=1:RETURN
  45. 1020  PRINT "ENTER 1 FOR REGULAR STATE WITHHOLD.                                             ENTER PERCENT IF FIXED PERCENT.                                                 ENTER 0 IF NO STATE WITHHOLDING OR IF EXEMPT.               ";
  46. 1030  NBR=1:INLN%=6:GOSUB 20050:SWITH=VAL(INPT$):NBR=0:IF REC3 THEN SW%=1:RETURN
  47. 1050  PRINT "ENTER 1 FOR REGULAR CITY WITHHOLD.                                              ENTER PERCENT IF FIXED PERCENT.                                                 ENTER 0 IF NO CITY WITHHOLDING OR IF EXEMPT.               ";
  48. 1060  NBR=1:INLN%=6:GOSUB 20050:CWITH=VAL(INPT$):NBR=0:IF REC3 THEN CW%=1:RETURN
  49. 1080  FL$="A:"+LEFT$(NAM2$,8)+"."+LEFT$(NAM1$,3):OPEN FL$ AS 3:FIELD 3, 8 AS A$, 20 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 35 AS E$, 13 AS F$:LSET A$=ES$:LSET B$=NAM2$:RSET C$=NAM1$:RSET CA$=MDL$:LSET D$=ADR$:LSET E$=CITY$:LSET F$=PHN$:PUT 3,1
  50. 1190  FIELD 3, 15 AS G$, 15 AS H$, 15 AS I$, 8 AS J$, 1 AS K$, 2 AS L$, 1 AS M$, 8 AS N$, 6 AS O$:LSET G$=SS$:LSET H$=PRF$:LSET I$=DRV$:LSET J$=SD$:LSET K$=MAR$:LSET L$=MKI$(EXM%):LSET M$=RAT$:LSET N$=MKS$(SAL):LSET O$=ENO$:PUT 3,2
  51. 1300  FIELD 3, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$:LSET P$=MIS1$:LSET Q$=MKS$(MIS1):LSET R$=MIS2$:LSET S$=MKS$(MIS2):LSET T$=MIS3$:LSET U$=MKS$(MIS3):LSET V$=MKS$(FWITH):LSET W$=MKS$(SWITH)
  52. 1390  LSET Z$=MKS$(CWITH):PUT 3,3:GOSUB 30210:CLOSE 3:LSET AA$=NAM2$:LSET BB$=NAM1$:LSET CC$=MDL$:LSET DD$="CURRENT":PUT 2, LOF(2)/128+1:IF REC1 THEN RETURN
  53. 1480  GOTO 50
  54. 1490  CLS
  55. 1500  GOSUB 330:FOR N=1 TO LOF(2)/128:GET 2,N:IF NAM2$=LEFT$(AA$,LEN(NAM2$)) AND NAM1$=LEFT$(BB$,LEN(NAM1$)) THEN IF LEFT$(MDL$,1)="." OR LEFT$(MDL$,1)=LEFT$(CC$,1) THEN 1590 ELSE 1540
  56. 1540  NEXT:PRINT "NAME NOT FOUND.  CHECK SPELLING AND REENTER                                     PRESS  R  TO REENTER                                                            PRESS  O  TO RETURN TO OPTIONS"
  57. 1560  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="R" THEN 1500 ELSE IF X$="O" THEN 50 ELSE 1560
  58. 1590  FL$="A:"+LEFT$(AA$,8)+"."+LEFT$(BB$,3):NAM2$="":OPEN FL$ AS 3:GOSUB 30210:FIELD 3, 8 AS A$, 20 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 35 AS E$, 13 AS F$:GET 3,1:IF EMD$="A" THEN LSET A$="CURRENT":PUT 3,1
  59. 1635  PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10)"P=READ AND PRINT(TURN ON PRINTER)
  60. 1650  PRT$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF PRT$<>"P" AND PRT$<>"R" THEN 1650
  61. 1680  CLS:GET 3,1:IF PRT$="P" THEN PRT=1
  62. 1705  FOR NS=1 TO LEN(C$):IF MID$(C$,NS,1)<>CHR$(32) THEN NOM$=MID$(C$,NS) ELSE NEXT
  63. 1710  PRINT "1.   NAME   " SPC(25) NOM$+" ";:IF LEFT$(CA$,1)=" " THEN PRINT " "+B$ ELSE PRINT CA$+" "+B$
  64. 1720  IF PRT THEN LPRINT "NAME   " SPC(25) NOM$+" ";:IF LEFT$(CA$,1)=" " THEN LPRINT " "+B$ ELSE LPRINT CA$+" "+B$
  65. 1730  PRINT "2.   EMPLOYEE STATUS   ";:IF PRT THEN LPRINT "EMPLOYEE STATUS   ";
  66. 1750  IF LEFT$(A$,3)="CUR" THEN PRINT SPC(14)"CURRENT" ELSE PRINT SPC(14)"EMPLOYMENT ENDED "+A$
  67. 1760  IF PRT THEN IF LEFT$(A$,3)="CUR" THEN LPRINT SPC(14)"CURRENT" ELSE LPRINT SPC(14) "EMPLOYMENT ENDED "+A$
  68. 1770  PRINT "3.   ADDRESS" SPC(25) D$:IF PRT THEN LPRINT "ADDRESS" SPC(25) D$
  69. 1790  PRINT "4.   CITY,STATE,ZIP" SPC(18) E$:IF PRT THEN LPRINT "CITY,STATE,ZIP" SPC(18) E$
  70. 1810  PRINT "5.   PHONE NUMBER" SPC(20) F$:IF PRT THEN LPRINT "PHONE NUMBER" SPC(20)F$
  71. 1830  FIELD 3, 15 AS G$, 15 AS H$, 15 AS I$, 8 AS J$, 1 AS K$, 2 AS L$, 1 AS M$, 8 AS N$, 6 AS O$:GET 3,2:PRINT "6.   SOCIAL SECURITY NO." SPC(13) G$:IF PRT THEN LPRINT "SOCIAL SECURITY NO." SPC(13) G$
  72. 1870  PRINT "7.   PROFESSIONAL LICENSE NO." SPC(8) H$:IF PRT THEN LPRINT "PROFESSIONAL LICENSE NO." SPC(8)H$
  73. 1890  PRINT "8.   DRIVERS LICENSE NO." SPC(13) I$:IF PRT THEN LPRINT "DRIVERS LICENSE NO." SPC(13) I$
  74. 1910  PRINT "9.   START DATE" SPC(22) J$:IF PRT THEN LPRINT "START DATE" SPC(22)J$
  75. 1930  PRINT "10.  MARRITAL STATUS" SPC(17) K$:IF PRT THEN LPRINT "MARRITAL STATUS" SPC(17) K$
  76. 1950  PRINT "11.  EXEMPTIONS CLAIMED";:PRINT SPC(13) CVI(L$):IF PRT THEN LPRINT "EXEMPTIONS CLAIMED";:LPRINT SPC(13) CVI(L$)
  77. 1970  PRINT "12.  PAY TYPE";:IF LEFT$(M$,1)="H" THEN PRINT SPC(24)"HOURLY" ELSE PRINT SPC(24) "SALARY"
  78. 1980  IF PRT THEN LPRINT "PAY TYPE";:IF LEFT$(M$,1)="H" THEN LPRINT SPC(24)"HOURLY" ELSE LPRINT SPC(24) "SALARY"
  79. 1990  PRINT "13.  RATE";:PRINT SPC(22) USING DL$;CVS(N$);:PRINT " PER ";:IF LEFT$(M$,1)="H" THEN PRINT "HOUR" ELSE PRINT "WEEK"
  80. 2000  IF PRT THEN LPRINT "RATE";:LPRINT SPC(22) USING DL$;CVS(N$);:LPRINT " PER ";:IF LEFT$(M$,1)="H" THEN LPRINT "HOUR" ELSE LPRINT "WEEK"
  81. 2010  PRINT "14.  EMPLOYEE NO." SPC(20) O$:IF PRT THEN LPRINT "EMPLOYEE NO." SPC(20) O$
  82. 2030  GET 3,3:FIELD 3, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$:IF LEFT$(P$,1)=CHR$(32) THEN PRINT "15.  MISCELLANEOUS DEDUCTION" ELSE PRINT "15.  "+P$+" DEDUCTION  ";:PRINT USING DL$;CVS(Q$)
  83. 2060  IF PRT THEN IF LEFT$(P$,1)=CHR$(32) THEN LPRINT "MISCELLANEOUS DEDUCTION" ELSE LPRINT P$+" DEDUCTION  ";:LPRINT USING DL$;CVS(Q$)
  84. 2070  IF LEFT$(R$,1)=CHR$(32) THEN PRINT "16.  MISCELLANEOUS DEDUCTION" ELSE PRINT "16.  "+R$+" DEDUCTION  ";:PRINT USING DL$;CVS(S$)
  85. 2080  IF PRT THEN IF LEFT$(R$,1)=" " THEN LPRINT "MISCELLANEOUS DEDUCTION" ELSE LPRINT R$+" DEDUCTION  ";:LPRINT USING DL$;CVS(S$)
  86. 2090  IF LEFT$(T$,1)=CHR$(32) THEN PRINT "17.  MISCELLANEOUS DEDUCTION" ELSE PRINT "17.  "+T$+" DEDUCTION  ";:PRINT USING DL$;CVS(U$)
  87. 2100  IF PRT THEN IF LEFT$(T$,1)=" " THEN LPRINT "MISCELLANEOUS DEDUCTION" ELSE LPRINT T$+" DEDUCTION  ";:LPRINT USING DL$;CVS(U$)
  88. 2110  FWITH=CVS(V$):PRINT "18.  FEDERAL WITHHOLDING             ";:IF FWITH<0.9 THEN PRINT "EXEMPT" ELSE IF FWITH<1.1 THEN PRINT "REGULAR" ELSE PRINT USING "##.##%";CVS(V$)
  89. 2130  IF PRT THEN LPRINT "FEDERAL WITHHOLDING             ";:IF CVS(V$)<0.9 THEN LPRINT "EXEMPT" ELSE IF CVS(V$)<1.1 THEN LPRINT "REGULAR" ELSE LPRINT USING "##.##%";CVS(V$)
  90. 2140  PRINT "19.  STATE WITHHOLDING               ";:IF CVS(W$)<0.9 THEN PRINT "NO STATE TAX OR EXEMPT" ELSE IF CVS(W$)<1.1 THEN PRINT "REGULAR" ELSE PRINT USING "##.##%";CVS(W$)
  91. 2150  IF PRT THEN LPRINT "STATE WITHHOLDING               ";:IF CVS(W$)<0.9 THEN LPRINT "NO STATE TAX OR EXEMPT" ELSE IF CVS(W$)<1.1 THEN LPRINT "REGULAR" ELSE LPRINT USING "##.##%";CVI(W$)
  92. 2160  PRINT "20.  CITY WITHHOLDING                ";:IF CVS(Z$)<0.9 THEN PRINT "NO CITY TAX OR EXEMPT" ELSE IF CVS(Z$)<1.1 THEN PRINT "REGULAR" ELSE PRINT USING "##.##%";CVS(Z$)
  93. 2170  IF PRT THEN LPRINT "CITY WITHHOLDING                ";:IF CVS(Z$)<0.9 THEN LPRINT "NO CITY TAX OR EXEMPT" ELSE IF CVS(Z$)<1.1 THEN LPRINT "REGULAR" ELSE LPRINT USING "##.##%";CVS(Z$):LPRINT:LPRINT
  94. 2175  IF PRT THEN LPRINT CHR$(12)
  95. 2180  PRINT:PRINT TAB(2) "A=READ ANOTHER     R=REVISE FILE     D=DELETE EMPLOYEE     O=RETURN TO OPTIONS"
  96. 2190  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="A" THEN CLOSE 3:GOTO 1490 ELSE IF X$="R" THEN 2310 ELSE IF X$="D" THEN 2220 ELSE IF X$="O" THEN CLOSE:GOTO 50 ELSE 2190
  97. 2220  CLS:PRINT "ENTER DATE EMPLOYMENT ENDED  ";:INLN%=8:GOSUB 20050:ES$=INPT$:GET 3,1:FIELD 3, 8 AS A$:LSET A$=ES$:PUT 3,1:GOSUB 30210:GET 2, LOC(2):GOSUB 2810:CLOSE:GOTO 50
  98. 2310  '
  99. 2320  LOCATE 21,1:PRINT STRING$(239,32):LOCATE 21,1:PRINT "ENTER NUMBER OF DATA TO BE CHANGED (ENTER 0 IF FINISHED)  ";:INLN%=2:NBR=1:GOSUB 20050:I=VAL(INPT$):NBR=0:IF I=0 THEN 2430 ELSE IF I<6 THEN REC1=1 ELSE IF I<15 THEN REC2=1 ELSE REC3=1
  100. 2360  LOCATE 21,1:PRINT STRING$(79,32):LOCATE 21,1:ON I GOSUB 330,2400,400,430,460,490,520,550,580,610,650,680,720,750,780,850,920,990,1020,1050:GOTO 2320
  101. 2390  GOTO 2430
  102. 2400  PRINT "ENTER DATE EMPLOYMENT ENDED OR ENTER CURRENT  ";:INLN%=8:GOSUB 20050:ES$=INPT$:ES=1:RETURN
  103. 2430  IF REC1 THEN 2440 ELSE 2520
  104. 2440  GET 3,1:FIELD 3, 8 AS A$, 20 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 35 AS E$, 13 AS F$:IF ES=1 THEN LSET A$=ES$:GET 2, LOC(2):GOSUB 2810
  105. 2470  IF NAM2$<>"" THEN LSET B$=NAM2$:RSET C$=NAM1$:RSET CA$=MDL$:GOSUB 2760:NAME FL$ AS LEFT$(AA$,8)+"."+LEFT$(BB$,3):FL$=LEFT$(AA$,8)+"."+LEFT$(BB$,3)
  106. 2480  IF ADR$<>"" THEN LSET D$=ADR$
  107. 2490  IF CITY$<>"" THEN LSET E$=CITY$
  108. 2500  IF PHN$<>"" THEN LSET F$=PHN$
  109. 2510  PUT 3,1:GOSUB 30210
  110. 2520  IF REC2 THEN 2530 ELSE 2650
  111. 2530  GET 3,2:FIELD 3, 15 AS G$, 15 AS H$, 15 AS I$, 8 AS J$, 1 AS K$, 2 AS L$, 1 AS M$, 8 AS N$, 6 AS O$:IF SS$<>"" THEN LSET G$=SS$
  112. 2560  IF PRF$<>"" THEN LSET H$=PRF$
  113. 2570  IF DRV$<>"" THEN LSET I$=DRV$
  114. 2580  IF SD$<>"" THEN LSET J$=SD$
  115. 2590  IF MAR$<>"" THEN LSET K$=MAR$
  116. 2600  IF EM% THEN LSET L$=MKI$(EXM%)
  117. 2610  IF RAT$<>"" THEN LSET M$=RAT$
  118. 2620  IF SL% THEN LSET N$=MKS$(SAL)
  119. 2630  IF ENO$<>"" THEN LSET O$=ENO$
  120. 2640  PUT 3,2:GOSUB 30210
  121. 2650  IF REC3 THEN 2660 ELSE 2750
  122. 2660  GET 3,3:FIELD 3, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$:IF LEFT$(P$,5)<>"     " AND MIS1$=" " THEN LSET P$=MIS1$:LSET Q$=MKS$(0) ELSE IF MIS1$<>"" THEN LSET P$=MIS1$:LSET Q$=MKS$(MIS1)
  123. 2690  IF LEFT$(R$,5)<>"     " AND MIS2$=" " THEN LSET R$=MIS2$:LSET S$=MKS$(0) ELSE IF MIS2$<>"" THEN LSET R$=MIS2$:LSET S$=MKS$(MIS2)
  124. 2700  IF LEFT$(T$,5)<>"     " AND MIS3$=" " THEN LSET T$=MIS3$:LSET U$=MKS$(0) ELSE IF MIS3$<>"" THEN LSET T$=MIS3$:LSET U$=MKS$(MIS3)
  125. 2710  IF FW% THEN LSET V$=MKS$(FWITH)
  126. 2720  IF SW% THEN LSET W$=MKS$(SWITH)
  127. 2730  IF CW% THEN LSET Z$=MKS$(CWITH)
  128. 2740  PUT 3,3:GOSUB 30210
  129. 2750  GOTO 50
  130. 2760  GET 2, LOC(2):LSET AA$=NAM2$:LSET BB$=NAM1$:LSET CC$=MDL$:IF ES=0 THEN 2820
  131. 2810  LSET DD$=ES$
  132. 2820  PUT 2, LOC(2):RETURN
  133. 2840  CLS
  134. 2850  PRINT "ENTER FIRST 3 LETTERS OF MONTH  ";:INLN%=3:GOSUB 20050:MON$=INPT$
  135. 2870  PRINT "ENTER DATE PAY PERIOD ENDED AS  XX-XX-XX   ";:INLN%=8:GOSUB 20050:PD$=INPT$:IF VAL(LEFT$(PD$,2))>12 THEN 2870 ELSE CH=VAL(LEFT$(PD$,2)):FOR N=1 TO CH:READ MO$:NEXT:IF MON$=MO$ THEN 2920
  136. 2900  PRINT:PRINT"MONTH DOES NOT MATCH DATE, PLEASE REENTER":RESTORE:GOTO 2850
  137. 2910  DATA JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC
  138. 2920  OPEN "A:DEDUCT.FIL" AS 4:FIELD 4, 8 AS A$, 10 AS B$:GET 4,1:STATE$=A$:STAT=CVD(B$):GET 4,2:CITY$=A$:CIT=CVD(B$):GET 4,3:FIC=CVD(A$):FMAX=CVD(B$):GET 4,4:SUMP=CVD(A$):SMAX=CVD(B$):GET 4,5:FUMP=CVD(A$):EFIC=CVD(B$):GET 4,6:AL=CVD(A$)
  139. 3050  FIELD 4, 10 AS A$, 10 AS B$, 10 AS C$, 10 AS D$:DIM LOW(18), HIGH(18), FED(18), FEDP(18):FOR N=7 TO 23:GET 4,N:LOW(N-6)=CVD(A$):HIGH(N-6)=CVD(B$):FED(N-6)=CVD(C$):FEDP(N-6)=CVD(D$):NEXT:CLOSE 4:IF X$="M" THEN 3190 ELSE IF X$="R" THEN 5700
  140. 3140  OPEN "B:EXPENSE.CUR" AS 1:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$
  141. 3160  IF LOF(1)/128<8 THEN COLOR 0,7:PRINT"CURRENT EXPENSE FILE NOT YET OPENED FOR THIS MONTH.":PRINT:PRINT"REMOVE PAYROLL DISK FROM DRIVE A AND INSERT PROGRAM DISK":PRINT:PRINT"PRESS F8 TO RETURN TO EXPENSE PROGRAM AND OPEN FILE":COLOR 7,0:BEEP ELSE 3190
  142. 3170  R$=INKEY$:IF R$<>"@" THEN 3170
  143. 3180  RUN "EXPENSE.BAS"
  144. 3190  OPEN "PAYROLL.TOT" AS 5:FIELD 5, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:IF LOF(5)/128<2 THEN GOSUB 5620
  145. 3211  GET 5,CH+5:IF N$="C" THEN BEEP:CLS:LOCATE 12,5:PRINT "******** THIS MONTH HAS ALREADY BEEN CLOSED OUT ******** ":LOCATE 14,5:PRINT "************ PRESS  F8  TO RETURN TO OPTIONS ***********":GOTO 3214
  146. 3213  GET 5,CH+4:IF CVD(B$)=0 THEN 3215 ELSE IF CH=1 OR N$="C" THEN 3215 ELSE BEEP:CLS:LOCATE 12,5:PRINT "*********** LAST MONTH HAS NOT BEEN CLOSED OUT ***********":LOCATE 14,5:PRINT "*********** PRESS  F8  TO RETURN TO OPTIONS ***********":GOTO 3214
  147. 3214  YY$=INKEY$:IF YY$<>"@" THEN 3214 ELSE 50
  148. 3215  IF X$="M" AND CH MOD 3=0 THEN 3270 ELSE IF X$="M" THEN 6560
  149. 3220  PRINT TAB(22) "ENTER DATE OF CHECK   ";:INLN%=8:GOSUB 20050:IF LEFT$(INPT$,1)="0" THEN ND$=MID$(INPT$,2,LEN(INPT$)-1) ELSE ND$=INPT$
  150. 3260  IF X$="I" THEN 5050
  151. 3270  FOR N=1 TO LOF(2)/128:GET 2,N:IF LEFT$(DD$,3)="   " THEN 50
  152. 3300  IF X$<>"M" AND LEFT$(DD$,3)<>"CUR" THEN 4900
  153. 3310  FL$="A:"+LEFT$(AA$,8)+"."+LEFT$(BB$,3)
  154. 3320  OPEN FL$ AS 3:NM=1:FIELD 3, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$:GET 3,3:FWITH=CVS(V$):SWITH=CVS(W$):CWITH=CVS(Z$):MIS1$=P$:MIS2$=R$:MIS3$=T$:GET 3,2
  155. 3390  FIELD 3, 15 AS G$, 15 AS H$, 15 AS I$, 8 AS J$, 1 AS K$, 2 AS L$, 1 AS M$, 8 AS N$, 6 AS O$:GRS=CVS(N$):MAR$=K$:RAT$=M$:EXM%=CVI(L$):SS$=G$:GET 3,4
  156. 3420  FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:YGROSS=CVD(B$):GET 3,1:FIELD 3, 8 AS A$, 20 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 35 AS E$, 13 AS F$
  157. 3460  FOR L%=1 TO 15:IF LEFT$(C$,L%)=STRING$(L%,32) THEN NEXT ELSE IF LEFT$(CA$,1)=" " THEN PAY$=RIGHT$(C$,16-L%)+" "+B$ ELSE PAY$=RIGHT$(C$,16-L%)+" "+LEFT$(CA$,1)+". "+B$
  158. 3465  IF X$="M" THEN GOSUB 30210:GOSUB 6150:GOTO 4900
  159. 3470  PRINT:PRINT "  EMPLOYEE" SPC(16) PAY$ SPC(6) SS$:IF LEFT$(RAT$,1)="S" THEN PRINT "  SALARY" ELSE PRINT
  160. 3480  IF MN$="M" THEN 3870 ELSE IF RF$="E" THEN 5750
  161. 3490  PRINT "DID EMPLOYEE WORK THIS WEEK? Y OR N"
  162. 3500  Y$=INKEY$:IF Y$="Y" AND LEFT$(RAT$,1)="S" THEN HRS=40:GOTO 3610 ELSE IF Y$="Y" THEN 3520 ELSE IF Y$="N" AND MN$<>"" THEN 5500 ELSE IF Y$="N" THEN 4900 ELSE 3500
  163. 3520  PRINT "ENTER REGULAR HOURS WORKED   ";:INLN%=5:NBR=1:GOSUB 20050:HRS=VAL(INPT$):PRINT "ENTER OVERTIME HOURS WORKED  ";:INLN%=5:GOSUB 20050:OHRS=VAL(INPT$):NBR=0:GROSS=(HRS+1.5*OHRS)*GRS:GOTO 3620
  164. 3580  PRINT "DID EMPLOYEE WORK THIS WEEK? Y OR N"
  165. 3590  Y$=INKEY$:IF Y$="Y" AND LEFT$(RAT$,1)="S" THEN 3610 ELSE IF Y$="Y" THEN 3490 ELSE IF Y$="N" THEN 4900 ELSE 3590
  166. 3610  GROSS=GRS
  167. 3620  IF FWITH<0.9 THEN 3720 ELSE IF FWITH<1.1 THEN 3630 ELSE 3730
  168. 3630  TAXABLE=GROSS-(EXM%*AL):IF LEFT$(MAR$,1)="S" THEN 3650 ELSE 3680
  169. 3650  FOR J=1 TO 8:IF TAXABLE<HIGH(J) THEN 3710
  170. 3670  NEXT J
  171. 3680  FOR J=9 TO 17:IF TAXABLE<HIGH(J) THEN 3710
  172. 3700  NEXT J
  173. 3710  FW=FED(J)+(FEDP(J)/100)*(TAXABLE-LOW(J)):GOTO 3740
  174. 3720  FW=0:GOTO 3740
  175. 3730  FW=GROSS*FWITH/100
  176. 3740  IF YGROSS>FMAX THEN FICA=0:GOTO 3770 ELSE IF GROSS+YGROSS>FMAX THEN 3760
  177. 3750  FICA=GROSS:GOTO 3770
  178. 3760  FICA=GROSS-(GROSS+YGROSS-FMAX)
  179. 3770  IF SWITH<0.9 THEN 3820 ELSE IF SWITH<1.1 THEN 3790
  180. 3780  SW=GROSS*SWITH/100:GOTO 3820
  181. 3790  IF LEFT$(STATE$,3)="FED" THEN SW=STAT/100*FW ELSE IF LEFT$(STATE$,3)="GRO" THEN SW=GROSS*STAT/100 ELSE IF LEFT$(STATE$,3)="ADJ" THEN SW=(GROSS-(EXM%*AL))*STAT/100
  182. 3800  GOTO 3820
  183. 3810  SW=0
  184. 3820  IF CWITH<0.9 THEN 3860 ELSE IF CWITH<1.1 THEN 3840
  185. 3830  CWITH=GROSS*CWITH/100:GOTO 3870
  186. 3840  IF LEFT$(CITY$,3)="GRO" THEN CW=GROSS*CIT/100 ELSE IF LEFT$(CITY$,3)="FED" THEN CW=FW*CIT/100 ELSE IF LEFT$(CITY$,3)="ADJ" THEN CW=(GROSS-EXM%*AL))*CIT/100 ELSE CW=SW*CIT/100
  187. 3850  GOTO 3870
  188. 3860  CW=0
  189. 3870  GET 3,3:FIELD 3, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$:MIS1=CVS(Q$):MIS2=CVS(S$):MIS3=CVS(U$):IF MN$="M" THEN 5220
  190. 3930  DEF FNA(A)=(CINT((A-INT(A))*100))/100+INT(A):GROSS=FNA(GROSS):FICA=FNA(FICA):FICAC=FNA(FICA*(FIC/100)):FW=FNA(FW):SW=FNA(SW):CW=FNA(CW):PNET=FNA(GROSS-FW-FICAC-SW-CW-MIS1-MIS2-MIS3)
  191. 3960  IF YGROSS>SMAX THEN UNEMP=0 ELSE IF YGROSS+GROSS>SMAX THEN UNEMP=GROSS-(GROSS+YGROSS-SMAX) ELSE UNEMP=GROSS
  192. 3970  PRINT"     GROSS";"        FICA";"   FED.WITH.";"   ST.WITH.";"   CITY WITH.":PRINT USING DL$;GROSS,FICAC,FW,SW,CW:PRINT:IF MIS1>0 THEN PRINT MIS1$;:PRINT USING DL$;MIS1
  193. 3975  IF MIS2>0 THEN PRINT MIS2$;:PRINT USING DL$;MIS2
  194. 3980  IF MIS3>0 THEN PRINT MIS3$;:PRINT USING DL$;MIS3
  195. 3990  PRINT:PRINT"NET PAID       ";:PRINT USING DL$;PNET:PRINT:PRINT TAB(10) "P=PRINT CHECK AND ENTER DATA":PRINT:PRINT TAB(10) "E=ENTER DATA (ENTERS IN PAYROLL FILE ONLY)":PRINT:PRINT TAB(10) "C=CANCEL AND ENTER MANUALLY LATER"
  196. 4000  PRT$=INKEY$:IF PRT$="P" OR PRT$="E" THEN 4020
  197. 4010  IF X$="I" AND PRT$="C" THEN 5500 ELSE IF PRT$="C" THEN 4900 ELSE 4000
  198. 4020  IF LOF(3)/128<20 THEN GOSUB 5550
  199. 4025  FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:LSET A$=PD$:LSET B$=MKD$(GROSS):LSET C$=MKD$(FICA):LSET D$=MKD$(FW):LSET E$=MKD$(SW):LSET F$=MKD$(CW)
  200. 4090  LSET G$=MKD$(MIS1):LSET H$=MKD$(MIS2):LSET I$=MKD$(MIS3):LSET J$=MKD$(PNET):LSET K$=MKD$(UNEMP):LSET L$=MKS$(HRS):LSET M$=MKS$(OHRS):LSET N$="O":PUT 3,LOF(3)/128+1:GOSUB 30210:GET 3,4:GOSUB 4200:GOTO 4370
  201. 4200  LSET A$=PD$:GROSSS=0:FICAS=0:FWS=0:SWS=0:CWS=0:MIS1S=0:MIS2S=0:MIS3S=0:PNETS=0:UNEMPS=0:HRSS=0:OHRSS=0
  202. 4220  GROSSS=GROSS+CVD(B$):FICAS=FICA+CVD(C$):FWS=FW+CVD(D$):SWS=SW+CVD(E$):CWS=CW+CVD(F$):MIS1S=MIS1+CVD(G$):MIS2S=MIS2+CVD(H$):MIS3S=MIS3+CVD(I$):PNETS=PNET+CVD(J$):UNEMPS=UNEMP+CVD(K$):HRSS=HRS+CVS(L$):OHRSS=OHRS+CVS(M$):LSET B$=MKD$(GROSSS)
  203. 4240  LSET C$=MKD$(FICAS):LSET D$=MKD$(FWS):LSET E$=MKD$(SWS):LSET F$=MKD$(CWS):LSET G$=MKD$(MIS1S):LSET H$=MKD$(MIS2S):LSET I$=MKD$(MIS3S):LSET J$=MKD$(PNETS):LSET K$=MKD$(UNEMPS):LSET L$=MKS$(HRSS):LSET M$=MKS$(OHRSS):LSET N$="O":RETURN
  204. 4370  PUT 3,4:GET 3,CH+8:GOSUB 4200:PUT 3,CH+8:IF CH<4 THEN GET 3,5 ELSE IF CH<7 THEN GET 3,6 ELSE IF CH<10 THEN GET 3,7 ELSE GET 3,8
  205. 4420  GOSUB 4200:PUT 3,LOC(3):FIELD 5, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:GET 5,1:GOSUB 4200:PUT 5,1:GET 5,CH+5:GOSUB 4200:PUT 5,CH+5
  206. 4510  IF CH<4 THEN GET 5,2 ELSE IF CH<7 THEN GET 5,3 ELSE IF CH<10 THEN GET 5,4 ELSE GET 5,5
  207. 4520  GOSUB 4200:PUT 5,LOC(5):GET 5,LOF(5)/128:IF PD$=A$ THEN CODE%=LOF(5)/128 ELSE CODE%=LOF(5)/128+1
  208. 4550  GOSUB 4200:PUT 5, CODE%:IF PRT$="P" THEN 4580 ELSE IF MN$="M" OR MN$="A" THEN 5500 ELSE 4870
  209. 4580  GET 3,4:FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$
  210. 4600  LPRINT CHR$(27)CHR$(45)CHR$(1)+CHR$(27)CHR$(69);:LPRINT PAY$;SPC(39-LEN(PAY$)) "WEEK ENDING  "+PD$+"   YR TO DATE":LPRINT SS$:LPRINT CHR$(27)CHR$(45)CHR$(0)+CHR$(27)CHR$(70):IF RAT$="S" THEN LPRINT:LPRINT:GOTO 4640
  211. 4630  LPRINT TAB(33)"REGULAR HOURS    ";:LPRINT USING "########.##";HRS,CVS(L$):LPRINT TAB(33)"OVERTIME HOURS   ";:LPRINT USING "########.##"; OHRS,CVS(M$)
  212. 4640  LPRINT TAB(33)"GROSS            ";:LPRINT USING DL$;GROSS,CVD(B$):LPRINT TAB(33)"FICA             ";:LPRINT USING DL$;FICAC,CVD(C$)*(FIC/100):LPRINT TAB(33) "FED. WITH.       ";:LPRINT USING DL$;FW,CVD(D$)
  213. 4650  LPRINT TAB(33) "STATE WITH.      ";:LPRINT USING DL$;SW,CVD(E$):IF CVD(F$)>0 OR CW>0 THEN LPRINT TAB(33)"CITY WITH.       ";:LPRINT USING DL$;CW,CVD(F$) ELSE CNT=CNT+1
  214. 4670  IF CVD(G$)>0 OR MIS1>0 THEN LPRINT TAB(33) MIS1$+"  ";:LPRINT USING DL$;MIS1,CVD(G$) ELSE CNT=CNT+1
  215. 4680  IF CVD(H$)>0 OR MIS2>0 THEN LPRINT TAB(33) MIS2$+"  ";:LPRINT USING DL$;MIS2,CVD(H$) ELSE CNT=CNT+1
  216. 4690  IF CVD(I$)>0 OR MIS3>0 THEN LPRINT TAB(33) MIS3$+"  ";:LPRINT USING DL$;MIS3,CVD(I$) ELSE CNT=CNT+1
  217. 4700  LPRINT:LPRINT TAB(33) "NET PAID         ";:LPRINT USING DL$;PNET, CVD(J$):FOR J=1 TO 9+CNT:LPRINT:NEXT J:LPRINT CHR$(27)CHR$(69)+CHR$(27)CHR$(71):LPRINT TAB(52) ND$+" "+CHR$(14);:LPRINT USING "**$###.##";PNET:LPRINT:LPRINT
  218. 4760  LPRINT TAB(7) PAY$:LPRINT:LPRINT:LPRINT CHR$(27)CHR$(64):FOR J=1 TO 10:LPRINT:NEXT:GET 1, LOF(1)/128:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:IF LOF(1)/128=9 THEN 4801 ELSE CHECK%=CVI(C$)+1:GOTO 4810
  219. 4801  FIELD 1, 10 AS M$, 5 AS Y$, 34 AS S$, 6 AS F$:GET 1,1:CHECK%=CVI(F$):FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$
  220. 4810  LSET D$=ND$:LSET C$=MKI$(CHECK%):LSET B$=PAY$:LSET A$=MKD$(PNET):LSET E$="WAGES":PUT 1, LOF(1)/128+1
  221. 4870  CNT=0:GROSS=0:FICA=0:FW=0:SW=0:CW=0:MIS1=0:MIS2=0:MIS3=0:PNET=0:UNEMP=0:IF MN$="M" OR MN$="A" THEN 5500
  222. 4890  CLS
  223. 4900  CLOSE 3:HRS=0:OHRS=0:IF N=LOF(2)/128 THEN 4910 ELSE NEXT N
  224. 4910  FIELD 5, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:IF X$="M" THEN 6560
  225. 4920  CLS:GET 5,CH+5:PRINT PD$:PRINT:PRINT"TOTAL WAGES PAID THIS MONTH        ";:PRINT USING DL$;CVD(B$):PRINT:PRINT"FICA WITHHELD THIS MONTH           ";:PRINT USING DL$;CVD(C$)*FIC/100:PRINT"FED.INCOME TAX WITHHELD THIS MONTH ";:PRINT USING DL$;CVD(D$)
  226. 4925  PRINT:PRINT TAB(9) "TOTAL WITHHELD THIS MONTH  ";:PRINT USING DL$;CVD(C$)*(FIC/100)+CVD(D$):PRINT "EMPLOYERS FICA CONTRIBUTION DUE    ";:PRINT USING DL$;CVD(C$)*(EFIC/100)
  227. 4935  PRINT "TOTAL FICA DUE THIS MONTH          ";:PRINT USING DL$;CVD(C$)*(EFIC+FIC)/100;:PRINT "   ON ";:PRINT USING DL$;CVD(C$)
  228. 4940  PRINT "TOTAL TAX DEPOSIT DUE THIS MONTH   ";:PRINT USING DL$;(EFIC+FIC)/100*CVD(C$)+CVD(D$):PRINT:PRINT "IF THIS AMOUNT LESS ANY DEPOSITS ALREADY MADE THIS MONTH IS GREATER THAN        $3000.00 THAN ADDITIONAL DEPOSIT IS DUE IN 3 DAYS."
  229. 4950  PRINT:PRINT TAB(10) "R=PRINT DEPOSIT INFORMATION (BE SURE PAPER IS IN PRINTER, NOT CHECKS)":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS"
  230. 4960  X$=INKEY$:IF X$<>"O" AND X$<>"R" THEN 4960
  231. 4980  IF X$="O" THEN 50 ELSE ELSE IF X$="R" THEN 4990
  232. 4990  LOCATE 11,1:PRINT STRING$(254,32):DEF SEG=4095:POKE 0,205:POKE 1,5:POKE 2,203:PRINT.SCREEN=0:CALL PRINT.SCREEN:GOTO 50
  233. 5050  CLS
  234. 5060  GOSUB 330:FL$="A:"+LEFT$(NAM2$,8)+"."+LEFT$(NAM1$,3):IF RF$="E" THEN 5120
  235. 5090  PRINT:PRINT TAB(10) "A=AUTOMATIC CALCULATION":PRINT:PRINT TAB(10) "M=ENTER AMOUNTS MANUALLY (CAN BE USED TO ENTER CORRECTIONS)"
  236. 5100  MN$=INKEY$:IF MN$<>"A" AND MN$<>"M" THEN 5100
  237. 5120  FIELD 2, 20 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$:FOR Z%=1 TO LOF(2)/128:GET 2,Z%:IF NAM2$=LEFT$(AA$,LEN(NAM2$)) AND NAM1$=LEFT$(BB$,LEN(NAM1$)) THEN IF LEFT$(MDL$,1)="." OR LEFT$(MDL$,1)=LEFT$(CC$,1) THEN 3320 ELSE 5160
  238. 5160  NEXT:PRINT "NAME NOT FOUND.  CHECK SPELLING AND REENTER                                     PRESS  R  TO REENTER                                                            PRESS  O  TO RETURN TO OPTIONS"
  239. 5180  Q$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF Q$="R" THEN 5060 ELSE IF Q$="O" THEN 50 ELSE 5180
  240. 5210  ***********************************
  241. 5220  PRINT "THIS PROCEDURE MAY BE USED TO PAY AN INDIVIDUAL EMPLOYEE OR TO ENTER CORRECTION ***** FOR CURRENT MONTH ONLY UNLESS PREVIOUS MONTH HAS NOT BEEN CLOSED OUT. ****" +"   CORRECTIONS MAY BE + OR - , BUT TOTAL OF DEDUCTIONS+NET MUST EQUAL GROSS."
  242. 5230  PRINT TAB(24)"ENTER 0 FOR ANY DATA NOT NEEDED.":PRINT:PRINT " ENTER REGULAR HOURS WORKED   ";:INLN%=8:NBR=1:GOSUB 20050:HRS=VAL(INPT$):PRINT "ENTER OVERTIME HOURS WORKED   ";:INLN%=8:GOSUB 20050:OHRS=VAL(INPT$):PRINT TAB(13)"ENTER GROSS PAY   ";
  243. 5290  INLN%=12:GOSUB 20050:GROSS=VAL(INPT$):PRINT TAB(18) "ENTER AMOUNT SUBJECT TO FICA   ";:INLN%=9:GOSUB 20050:FICA=VAL(INPT$):DEF FNA(A)=(CINT((A-INT(A))*100))/100+INT(A):FICAC=FNA(FICA*(FIC/100))
  244. 5300  PRINT "          FICA DEDUCTION IS   ";:PRINT USING "####.##";FICAC:PRINT "  ENTER FEDERAL WITHHOLDING   ";
  245. 5330  INLN%=9:GOSUB 20050:FW=VAL(INPT$):PRINT "    ENTER STATE WITHHOLDING   ";:INLN%=9:GOSUB 20050:SW=VAL(INPT$):PRINT "     ENTER CITY WITHHOLDING   ";:INLN%=9:GOSUB 20050:CW=VAL(INPT$):PRINT "ENTER AMT. SUBJECT TO UNEMP.  ";
  246. 5377  INLN%=10:GOSUB 20050:UNEMP=VAL(INPT$):IF LEFT$(MIS1$,3)<>"   " THEN PRINT MIS1$+" DEDUCTION":LOCATE CSRLIN-1,31 ELSE 5400
  247. 5390  INLN%=9:GOSUB 20050:MIS1=VAL(INPT$)
  248. 5400  IF LEFT$(MIS2$,3)<>"   " THEN PRINT MIS2$+" DEDUCTION":LOCATE CSRLIN-1,31: ELSE 5420
  249. 5410  INLN%=9:GOSUB 20050:MIS2=VAL(INPT$)
  250. 5420  IF LEFT$(MIS3$,3)<>"   " THEN PRINT MIS3$+" DEDUCTION":LOCATE CSRLIN-1,31: ELSE 5440
  251. 5430  INLN%=9:GOSUB 20050:MIS3=VAL(INPT$)
  252. 5440  PRINT TAB(19) "ENTER NET   ";:INLN%=9:GOSUB 20050:PNET=VAL(INPT$):NBR=0:IF ABS(GROSS-FICAC-FW-SW-CW-MIS1-MIS2-MIS3-PNET)>0.005 THEN 5470 ELSE 3970
  253. 5470  PRINT "AMOUNTS ARE OUT OF BALANCE.  GROSS MUST EQUAL TOTAL DEDUCTIONS+NET.":PRINT "RECHECK FIGURES AND REENTER": PRINT "PRESS  F8  WHEN READY."
  254. 5480  Z$=INKEY$:IF Z$="@" THEN CLS:GOTO 5220 ELSE 5480
  255. 5500  CLS:PRINT:PRINT:PRINT TAB(10) "N=NEXT EMPLOYEE (ONLY IF SAME DATE)":PRINT:PRINT TAB(10) "F=FINISHED, RETURN TO PAYROLL OPTIONS"
  256. 5510  W$=INKEY$:IF W$="N" THEN CLOSE 3:GOTO 5050 ELSE IF W$="F" THEN 4910 ELSE 5510
  257. 5540  '
  258. 5550  FOR J=4 TO 20:FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:INIT$=MKD$(0)
  259. 5580  LSET A$=" ":LSET B$=INIT$:LSET C$=INIT$:LSET D$=INIT$:LSET E$=INIT$:LSET F$=INIT$:LSET G$=INIT$:LSET H$=INIT$:LSET I$=INIT$:LSET J$=INIT$:LSET K$=INIT$:LSET L$=INIT$:LSET M$=INIT$:LSET N$=" ":PUT 3,J:NEXT J:RETURN
  260. 5620  FOR J=1 TO 17:FIELD 5, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:INIT$=MKD$(0)
  261. 5660  LSET A$=" ":LSET B$=INIT$:LSET C$=INIT$:LSET D$=INIT$:LSET E$=INIT$:LSET F$=INIT$:LSET G$=INIT$:LSET H$=INIT$:LSET I$=INIT$:LSET J$=INIT$:LSET K$=INIT$:LSET L$=INIT$:LSET M$=INIT$:LSET N$=" ":PUT 5,J:NEXT J:RETURN
  262. 5700  CLS:DEFINT S,O:PRINT:PRINT TAB(10) "E=EMPLOYEES FILE":PRINT:PRINT TAB(10) "T=TOTALS FILE":DEF SEG=64:POKE 23, (PEEK(23) OR 64)
  263. 5730  RF$=INKEY$:IF RF$="E" THEN 5050 ELSE IF RF$="T" THEN 6050 ELSE 5730
  264. 5750  PRINT:PRINT TAB(10) "ENTER MONTH TO READ WHOLE MONTH":PRINT:PRINT TAB(10) "ENTER DATE AS XX/XX/XX OR RANGE OF DATES AS XX/XX/XX-XX/XX/XX TO READ"
  265. 5755  PRINT:PRINT TAB(10) "ENTER T-NAME OF MONTH   TO READ MONTHLY TOTALS":PRINT:PRINT TAB(10) "ENTER Q-NUMBER OF QUARTER   TO READ QUARTERLY TOTALS":PRINT:PRINT TAB(10) "ENTER Y TO READ YEAR-TO-DATE TOTALS":INLN%=17:GOSUB 20050:RL$=INPT$
  266. 5765  IF ASC(RL$)=84 THEN STP$="T":RL$=MID$(RL$,3):GOTO 5810 ELSE IF ASC(RL$)=81 THEN STP$="T":GET 3,VAL(MID$(RL$,3))+4-OT:GOTO 5820 ELSE IF ASC(RL$)=89 THEN STP$="T":GET 3,4-OT:GOTO 5820
  267. 5770  IF ASC(RL$)<64 THEN STRT=VAL(LEFT$(RL$,2)):STRT2=VAL(MID$(RL$,4,2)) ELSE 5810
  268. 5780  RESTORE:FOR CH%=1 TO 12:CH=CH%:READ M0$: IF VAL(LEFT$(RL$,2))=CH THEN MON$=MO$:GOTO 5790 ELSE NEXT
  269. 5790  IF LEN(RL$)<9 THEN STP=STRT:STP2=STRT2+1:GOTO 5820
  270. 5800  STP=VAL(MID$(RL$,10,2)):STP2=VAL(MID$(RL$,13,2))+1:GOTO 5820
  271. 5810  RESTORE:FOR CH%=1 TO 12:CH=CH%:READ MO$:IF LEFT$(RL$,3)=MO$ THEN STRT=CH:STP=CH+1 ELSE NEXT
  272. 5815  IF STP$="T" THEN GET 3,CH+8-OT
  273. 5820  PRINT:PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10) "P=READ AND PRINT":DEF SEG=64:POKE 23, (PEEK(23) OR 64)
  274. 5840  PRT$=INKEY$:IF PRT$="P" OR PRT$="R" THEN CLS:GOTO 5842 ELSE 5840
  275. 5842  IF OT THEN PRINT TAB(16) "************TOTALS FOR ALL EMPLOYEES************":PRINT: :GOTO 5843 ELSE LOCATE 25,5:PRINT"**********"+NAM1$+" "+NAM2$+"**********":LOCATE 1,1
  276. 5843  IF PRT$="P" THEN LPRINT CHR$(27)CHR$(78)CHR$(10):JT=7:GOTO 6180
  277. 5845  IF STP$="T" THEN 5900
  278. 5850  COLOR 0,7: PRINT "     PRESS   F8   TO READ RECORDS IN SEQUENCE. PRESS   F7  TO STOP AT ANY POINT. PRESS   F8  WHEN READY TO CONTINUE READING.":COLOR 7,0: PRINT:PRINT:KEY(7) ON:ON KEY(7) GOSUB 9460
  279. 5860  RD$=INKEY$:IF RD$<>"@" THEN 5860 ELSE DEF SEG:POKE 106,0
  280. 5880  FOR N=21 TO LOF(3)/128:GET 3,N
  281. 5900  FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:IF STP$="T" THEN 5941
  282. 5910  IF STRT2=0 AND STRT=<VAL(LEFT$(A$,2)) THEN 5940 ELSE IF STRT2=0 THEN 5980
  283. 5920  IF STRT=VAL(LEFT$(A$,2)) AND STRT2=<VAL(MID$(A$,4,2)) THEN 5940 ELSE IF STRT<VAL(LEFT$(A$,2)) THEN 5940 ELSE 5980
  284. 5930  GOTO 5980
  285. 5940  IF STP2=0 AND STP=VAL(LEFT$(A$,2)) THEN 5990 ELSE IF STP=VAL(LEFT$(A$,2)) AND STP2=<VAL(MID$(A$,4,2)) THEN 5990 ELSE IF STP<VAL(LEFT$(A$,2)) THEN 5990
  286. 5941  QT$=" QUARTER TOTALS TO DATE":IF NM THEN ORDT=LOC(3)-3 ELSE ORDT=LOC(3)
  287. 5942  IF ORDT>5 AND ORDT<18 THEN HD$=RL$+" TOTALS TO DATE":GOTO 5944 ELSE IF ORDT>17 THEN HD$=A$:GOTO 5944
  288. 5943  IF ORDT=1 THEN HD$="YEAR-TO-DATE TOTALS" ELSE IF ORDT=2 THEN HD$="1ST"+QT$ ELSE IF ORDT=3 THEN HD$="2ND"+QT$ ELSE IF ORDT=4 THEN HD$="3RD"+QT$ ELSE IF ORDT=5 THEN HD$="4TH"+QT$
  289. 5944  PRINT:PRINT HD$;"   REGULAR HOURS ";CVS(L$);"  OVERTIME HOURS ";:IF CVS(M$)<0.1 THEN PRINT 0 ELSE PRINT CVS(M$):PRINT
  290. 5945  PRINT"     GROSS";"        FICA";"   FED.WITH.";"   ST.WITH.";" CITY WITH.";"   NET PAID":PRINT USING DL$;CVD(B$),CVD(C$)*(FIC/100),CVD(D$),CVD(E$),CVD(F$),CVD(J$):PRINT:IF CVD(G$)>0.1 THEN PRINT MIS1$;:PRINT USING DL$;CVD(G$)
  291. 5950  IF CVD(H$)>0.1 THEN PRINT MIS2$;:PRINT USING DL$;CVD(H$)
  292. 5955  IF CVD(I$)>0.1 THEN PRINT MIS3$;:PRINT USING DL$;CVD(I$)
  293. 5958  IF PRT$="P" THEN 6280
  294. 5959  IF STP$="T" THEN 5990
  295. 5980  NEXT:IF OT THEN 6100
  296. 5990  IF STP$="T" THEN IF OT THEN 6100 ELSE 5992
  297. 5991  STP$="T":GET 3,CH+8-OT:GOTO 5900
  298. 5992  STRT=0:STRT2=0:STRT$="":STP=0:STP2=0:STP$="":KEY(7) OFF
  299. 5995  PRINT:PRINT TAB(10) "A=READ ANOTHER RECORD FOR SAME EMPLOYEE":PRINT:PRINT TAB(10) "E=READ ANOTHER EMPLOYEES RECORDS":PRINT:PRINT TAB(10) "T=READ TOTALS FILE":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS"
  300. 6000  Z$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF Z$="A" THEN CLS:GOTO 5750 ELSE IF Z$="E" THEN CLOSE 3:GOTO 5050 ELSE IF Z$="T" THEN CLOSE 3:GOTO 6050 ELSE IF Z$="O" THEN 50 ELSE 6000
  301. 6050  NM=0:OT=3:OPEN "PAYROLL.TOT" AS 3
  302. 6070  CLS:PRINT:PRINT TAB(10) "ENTER  Y   TO READ YEAR-TO-DATE TOTALS":PRINT:PRINT TAB(10) "ENTER  Q-NUMBER OF QUARTER   TO READ QUARTERLY TOTALS":PRINT:PRINT TAB(10) "ENTER  T-MONTH   TO READ MONTHLY TOTALS":INLN%=17:GOSUB 20050:RL$=INPT$:RT=1
  303. 6090  GOTO 5765
  304. 6100  PRINT:PRINT TAB(10) "A=READ ANOTHER RECORD IN TOTALS FILE":PRINT:PRINT TAB(10) "E=READ AN EMPLOYEES RECORD":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS"
  305. 6110  RF$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF RF$="A" THEN 6070 ELSE IF RF$="E" THEN OT=0:CLOSE 3:GOTO 5050 ELSE IF RF$="O" THEN 50 ELSE 6110
  306. 6150  E0M=1:IF CH MOD 3=0 THEN QT=1
  307. 6170  IF CH=12 THEN YR=1
  308. 6180  LPRINT CHR$(15)+CHR$(27)CHR$(78)CHR$(10):WIDTH "LPT1:",132:IF N<>1 THEN 6190
  309. 6185  IF TTLS THEN 6200
  310. 6190  LPRINT CHR$(27)CHR$(45)CHR$(1) TAB(20) PAY$+"     "+SS$
  311. 6200  LPRINT "DATE          REG.HRS.   OT HRS.    GROSS        FICA     FED.WITH.    ST.WITH.   ";:IF CIT>0 THEN NT=1:LPRINT "CIT.WITH.   ";
  312. 6220  IF MIS1$<>STRING$(15,32) THEN NT1=1:LPRINT MIS1$;
  313. 6230  IF MIS2$<>STRING$(15,32) THEN NT2=1:LPRINT MIS2$;
  314. 6240  IF MIS3$<>STRING$(15,32) THEN NT3=1:LPRINT MIS3$;
  315. 6245  IF MIS1$=STRING$(15,32) THEN LPRINT "     ";
  316. 6246  IF TTLS THEN LPRINT "           NET":LPRINT:GOTO 6410
  317. 6250  LPRINT"           NET":LPRINT CHR$(27)CHR$(45)CHR$(0):IF JT=7 THEN 5845
  318. 6255  FOR J=21 TO LOF(3)/128:FIELD 3, 8 AS A$:GET 3,J:IF VAL(LEFT$(A$,2))>CH THEN 6410 ELSE IF VAL(LEFT$(A$,2))<CH-2 THEN 6400
  319. 6280  DX$="$$#######.##":IF JT=7 AND STP$="T" THEN LPRINT HD$:LPRINT A$; ELSE IF JT=7 OR JT=0 THEN LPRINT A$;
  320. 6287  FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$
  321. 6288  LPRINT "      ";:LPRINT USING "####.##";CVS(L$);:IF CVS(M$)<0.1 THEN LPRINT "     0.00"; ELSE LPRINT USING "#####.##";CVS(M$);
  322. 6290  LPRINT USING DX$;CVD(B$);CVD(C$)*(FIC/100); CVD(D$); CVD(E$);:IF CIT>0.01 THEN LPRINT USING DX$;CVD(F$);
  323. 6310  IF CVD(G$)>0.1 THEN LPRINT USING DX$;CVD(G$);
  324. 6320  IF CVD(H$)>0.1 THEN LPRINT USING DX$;CVD(H$);
  325. 6330  IF CVD(I$)>0.1 THEN LPRINT "   ";:LPRINT USING DX$;CVD(I$);
  326. 6340  LPRINT "         ";:LPRINT USING DX$;CVD(J$):IF JT=6 THEN LPRINT:LPRINT "     FICA WAGES PAID ";:LPRINT USING DL$;CVD(C$)
  327. 6350  ON JT GOTO 6440,6450,6470,6490,6510,6530,5959
  328. 6400  NEXT
  329. 6410  RESTORE:FOR NZ=1 TO CH:READ MO$:IF NZ=CH-2 THEN MO1$=MO$:GOTO 6411 ELSE IF NZ=CH-1 THEN MO2$=MO$:GOTO 6411 ELSE 6411
  330. 6411  NEXT NZ:RESTORE:LPRINT CHR$(27)CHR$(45)CHR$(1);:FOR NY=1 TO 3:IF CH MOD 3=0 AND NY=1 THEN GET 3,CH+6-OT:LPRINT MO1$+". TOT";:GOTO 6430
  331. 6415  IF CH MOD 3=0 AND NY=2 THEN GET 3,CH+7-OT:LPRINT MO2$+". TOT";:GOTO 6430
  332. 6416  IF NY=1 OR NY=2 THEN 6440
  333. 6420  GET 3,CH+8-OT:LPRINT MO$+". TOT";
  334. 6430  JT=1:GOTO 6280
  335. 6440  NEXT NY:LSET N$="C":PUT 3,LOC(3):LPRINT:GET 3,5-OT:JT=2:LPRINT "1ST QTR ";:GOTO 6280
  336. 6450  IF CH=3 THEN LSET N$="C":PUT 3,5-OT
  337. 6460  IF CH>3 THEN GET 3,6-OT:JT=3:LPRINT "2ND QTR ";:GOTO 6280
  338. 6470  IF CH=6 THEN LSET N$="C":PUT 3,6-OT
  339. 6480  IF CH>6 THEN GET 3,7-OT:JT=4:LPRINT "3RD QTR ";:GOTO 6280
  340. 6490  IF CH=9 THEN LSET N$="C":PUT 3,7-OT
  341. 6500  IF CH>9 THEN GET 3,8-OT:JT=5:LPRINT "4TH QTR ";:GOTO 6280
  342. 6510  IF CH=12 THEN LSET N$="C":PUT 3,8-OT
  343. 6520  GET 3,4-OT:JT=6:LPRINT RIGHT$(PD$,2)+"  YTD ";:GOTO 6280
  344. 6530  IF CH=12 THEN LSET N$="C":PUT 3,4-OT
  345. 6532  IF TTLS THEN 6590
  346. 6535  LPRINT CHR$(27)CHR$(45)CHR$(0):JT=0:IF QT>0.5 OR N MOD 4=0 THEN LPRINT CHR$(12)
  347. 6550  RETURN
  348. 6560  CLOSE 3:OPEN "PAYROLL.TOT" AS 3:FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$
  349. 6580  TTLS=1:OT=3:LPRINT CHR$(14)+CHR$(27)CHR$(45)CHR$(1):LPRINT "PAYROLL TOTALS":GET 3,1:LPRINT CHR$(15):WIDTH "LPT1:",132:IF CVD(G$)>0.01 THEN MIS1$="MISC.  1" ELSE MIS1$=STRING$(15,32)
  350. 6587  IF CVD(H$)>0.01 THEN MIS2$="MISC.  2" ELSE MIS2$=STRING$(15,32)
  351. 6588  IF CVD(I$)>0.01 THEN MIS3$="MISC.  3" ELSE MIS3$=STRING$(15,32)
  352. 6589  GOTO 6200
  353. 6590  LPRINT CHR$(18);:WIDTH "LPT1:",80:FOR J=1 TO 3:LPRINT STRING$(55,42):IF J=1 THEN GET 3,CH+5:LPRINT MO$;:LPRINT ". TAXES DUE":GOTO 6610 ELSE IF J=3 THEN GET 3,1:GOTO 6606
  354. 6601  IF CH<4 THEN LPRINT "1ST QTR TAXES DUE":GET 3,2 ELSE IF CH<7 THEN LPRINT "2ND QTR TAXES DUE":GET 3,3 ELSE IF CH<10 THEN LPRINT "3RD QTR TAXES DUE":GET 3,4 ELSE LPRINT "4TH QTR TAXES DUE":GET 3,5
  355. 6603  GOTO 6610
  356. 6606  IF VAL(RIGHT$(PD$,2))>82 THEN LPRINT "19"; ELSE LPRINT "20";
  357. 6607  LPRINT RIGHT$(PD$,2)+" TAXES DUE YTD"
  358. 6610  LPRINT "FICA WITHHELD            ";:LPRINT USING DL$;CVD(C$)*(FIC/100):LPRINT "FED.INCOME TAX WITHHELD  ";:LPRINT USING DL$;CVD(D$):LPRINT:LPRINT TAB(9)" TOTAL WITHHELD            ";:LPRINT USING DL$;CVD(C$)*(FIC/100)+CVD(D$)
  359. 6615  LPRINT "EMPLOYERS FICA CONTRIBUTION DUE    ";:LPRINT USING DL$;CVD(C$)*(EFIC/100):LPRINT "    TOTAL FICA TAXES               ";:LPRINT USING DL$;CVD(C$)*(FIC+EFIC)/100;:LPRINT " ON  ";:LPRINT USING DL$;CVD(C$)
  360. 6620  LPRINT"TOTAL TAX DEPOSIT DUE              ";:LPRINT USING DL$;(EFIC+FIC)/100*CVD(C$)+CVD(D$):IF J=1 THEN LPRINT:LPRINT "IF THIS AMOUNT LESS ANY DEPOSITS ALREADY MADE THIS MONTH IS GREATER THAN        $3000.00 THAN ADDITIONAL DEPOSIT IS DUE IN 3 DAYS
  361. 6630  LPRINT "STATE WITHHOLDING DUE              ";:LPRINT USING DL$;CVD(E$):IF CIT>0 THEN LPRINT "WITHHOLDING DUE             ";:LPRINT USING DL$;CVD(F$)
  362. 6650  LPRINT "STATE UNEMPLOYMENT TAX DUE         ";:LPRINT USING DL$;CVD(K$)*(SUMP/100);:LPRINT "     ON  ";:LPRINT USING DL$;CVD(K$):LPRINT "FEDERAL UNEMPLOYMENT TAX DUE       ";:LPRINT USING DL$;CVD(K$)*(FUMP/100):NEXT
  363. 6680  LPRINT CHR$(12)+CHR$(27)CHR$(64):CLS:PRINT:PRINT TAB(15) "PRESS  P  TO PRINT AGAIN ELSE JUST PRESS ENTER"
  364. 6700  AG$=INKEY$:IF AG$="P" THEN 6560 ELSE IF AG$=CHR$(13) THEN 50 ELSE 6700
  365. 7000  CLS:IF ERR=71 THEN COLOR 0,7:PRINT "     FILE DISK NOT IN DRIVE B OR PAYROLL DISK NOT IN DRIVE A OR DOOR IS OPEN.":PRINT:PRINT"CORRECT PROBLEM AND PRESS F8 WHEN READY. ":GOTO 7100
  366. 7020  IF ERR=24 OR ERR=27 THEN COLOR 0,7:PRINT "     PRINTER NOT ON OR OUT OF PAPER.  SET TOP OF PAGE AND TURN ON PRINTER.           PRESS F8 WHEN READY.    ":GOTO 7100
  367. 7030  IF ERR=53 THEN COLOR 0,7:PRINT "      FILE NOT FOUND ":PRINT:PRINT "     INSERT DISK CONTAINING FILE AND PRESS F8 WHEN READY. ":GOTO 7100
  368. 7040  PRINT " AN UNDEFINED ERROR HAS OCCURRED":PRINT:PRINT "PRESS F8 TO RETURN TO MENU"
  369. 7050  ER$=INKEY$:IF ER$<>"@" THEN 7050 ELSE COLOR 7,0:GOTO 50
  370. 7100  ER$=INKEY$:IF ER$<>"@" THEN 7100 ELSE COLOR 7,0:CLS:DEF SEG:POKE 106,0:RESUME
  371. 7300  CLS:PRINT:PRINT "DO YOU HAVE TWO BLANK DISKS AVAILABLE WHICH HAVE BEEN FORMATTED                 WITH THE  N  PROCEDURE FROM THE PROGRAM DISK  Y/N ?"
  372. 7320  FR$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF FR$="Y" THEN 7400 ELSE IF FR$="N" THEN 7350 ELSE 7320
  373. 7350  CLS:PRINT:PRINT TAB(10)"REMOVE BOTH DISKS AND INSERT PROGRAM DISK IN DRIVE  A.":PRINT:PRINT TAB(10)"PRESS  F8  WHEN READY"
  374. 7360  RD$=INKEY$:IF RD$="@" THEN 7380 ELSE 7360
  375. 7380  PRINT:PRINT:PRINT TAB(10) "YOU WILL BE RETURNED TO PAYROLL PROGRAM AFTER DISKS HAVE BEEN FORMATTED AND YOU WILL HAVE TO SELECT  F  OPTION AGAIN.":PRINT:PRINT TAB(10) "ENTER  N  WHEN  A>  PROMPT APPEARS.":SYSTEM
  376. 7400  PRINT:PRINT TAB(10) "MOST RECENT PAYROLL FILE DISK MUST BE IN DRIVE  A":PRINT:PRINT TAB(10) "IS THIS FOR A NEW YEAR  Y/N ?"
  377. 7410  NY$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF NY$="" THEN 7410
  378. 7440  PRINT:PRINT TAB(10) "INSERT NEW PAYROLL FILE DISK IN DRIVE  B":PRINT:PRINT TAB(10) "PRESS  F8  WHEN READY."
  379. 7450  CP$=INKEY$:IF CP$="@" THEN 7465 ELSE 7450
  380. 7465  CLS:LOCATE 12,22:PRINT "COPYING FILES *** PLEASE WAIT"
  381. 7470  OPEN "B:EMPLOYEE.CNT" AS 1:FOR N=1 TO LOF(2)/128:FIELD 2, 20 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$:GET 2,N:FL$="A:"+LEFT$(AA$,8)+"."+LEFT$(BB$,3):NFL$="B:"+LEFT$(AA$,8)+"."+LEFT$(BB$,3):IF NY$="Y" THEN IF LEFT$(DD$,3)<>"CUR" THEN 7750
  382. 7525  A$=AA$:B$=BB$:C$=CC$:D$=DD$:FIELD 1, 20 AS AA$, 15 AS BB$, 2 AS CC$, 9 AS DD$:LSET AA$=A$:LSET BB$=B$:LSET CC$=C$:LSET DD$=D$:PUT 1,LOF(1)/128+1:OPEN FL$ AS 3:OPEN NFL$ AS 4
  383. 7565  FIELD 3, 8 AS A$, 20 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 35 AS E$, 13 AS F$:GET 3,1:G$=A$:H$=B$:I$=C$:J$=CA$:K$=D$:L$=E$:M$=F$:FIELD 4, 8 AS A$, 20 AS B$, 15 AS C$, 2 AS CA$, 35 AS D$, 35 AS E$, 13 AS F$
  384. 7590  LSET A$=G$:LSET B$=H$:LSET C$=I$:LSET CA$=J$:LSET D$=K$:LSET E$=L$:LSET F$=M$:PUT 4,1:FIELD 3, 15 AS G$, 15 AS H$, 15 AS I$, 8 AS J$, 1 AS K$, 2 AS L$, 1 AS M$, 8 AS N$, 6 AS O$:GET 3,2
  385. 7620  A$=G$:B$=H$:C$=I$:D$=J$:E$=K$:F%=CVI(L$):P$=M$:Q!=CVS(N$):R$=O$:FIELD 4, 15 AS G$, 15 AS H$, 15 AS I$, 8 AS J$, 1 AS K$, 2 AS L$, 1 AS M$, 8 AS N$, 6 AS O$
  386. 7630  LSET G$=A$:LSET H$=B$:LSET I$=C$:LSET J$=D$:LSET K$=E$:LSET L$=MKI$(F%):LSET M$=P$:LSET N$=MKS$(Q!):LSET O$=R$:PUT 4,2:FIELD 3, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$:GET 3,3
  387. 7660  A$=P$:B!=CVS(Q$):C$=R$:D!=CVS(S$):E$=T$:F!=CVS(U$):G!=CVS(V$):H!=CVS(W$):I!=CVS(Z$):FIELD 4, 15 AS P$, 8 AS Q$, 15 AS R$, 8 AS S$, 15 AS T$, 7 AS U$, 7 AS V$, 7 AS W$, 7 AS Z$
  388. 7670  LSET P$=A$:LSET Q$=MKS$(B!):LSET R$=C$:LSET S$=MKS$(D!):LSET T$=E$:LSET U$=MKS$(F!):LSET V$=MKS$(G!):LSET W$=MKS$(H!):LSET Z$=MKS$(I!):PUT 4,3:IF NY$="Y" OR NY$="y" THEN 7750
  389. 7700  FOR I=4 TO 8:FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:GET 3,I
  390. 7725  Z$=A$:B=CVD(B$):C=CVD(C$):D=CVD(D$):E=CVD(E$):F=CVD(F$):G=CVD(G$):H=CVD(H$):I#=CVD(I$):J#=CVD(J$):K=CVD(K$):L!=CVS(L$):M!=CVS(M$):Y$=N$
  391. 7730  FIELD 4, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$
  392. 7735  LSET A$=Z$:LSET B$=MKD$(B):LSET C$=MKD$(C):LSET D$=MKD$(D):LSET E$=MKD$(E):LSET F$=MKD$(F):LSET G$=MKD$(G):LSET H$=MKD$(H):LSET I$=MKD$(I#):LSET J$=MKD$(J#):LSET K$=MKD$(K):LSET L$=MKS$(L!):LSET M$=MKS$(M!):LSET N$=Y$:PUT 4,I:NEXT I
  393. 7750  CLOSE 3:CLOSE 4:NEXT N:IF NY$="Y" OR NY$="y" THEN CLOSE 1:GOTO 7900
  394. 7780  OPEN "A:PAYROLL.TOT" AS 3:OPEN "B:PAYROLL.TOT" AS 4:FOR J=1 TO 5:FIELD 3, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$:GET 3,J
  395. 7825  Z$=A$:B=CVD(B$):C=CVD(C$):D=CVD(D$):E=CVD(E$):F=CVD(F$):G=CVD(G$):H=CVD(H$):I#=CVD(I$):J#=CVD(J$):K=CVD(K$):L!=CVS(L$):M!=CVS(M$):Y$=N$
  396. 7830  FIELD 4, 8 AS A$, 12 AS B$, 10 AS C$, 10 AS D$, 10 AS E$, 10 AS F$, 10 AS G$, 10 AS H$, 10 AS I$, 10 AS J$, 10 AS K$, 8 AS L$, 8 AS M$, 1 AS N$
  397. 7835  LSET A$=Z$:LSET B$=MKD$(B):LSET C$=MKD$(C):LSET D$=MKD$(D):LSET E$=MKD$(E):LSET F$=MKD$(F):LSET G$=MKD$(G):LSET H$=MKD$(H):LSET I$=MKD$(I#):LSET J$=MKD$(J#):LSET K$=MKD$(K):LSET L$=MKS$(L!):LSET M$=MKS$(M!):LSET N$=Y$:PUT 4,J:NEXT J
  398. 7860  CLOSE 1:CLOSE 3:CLOSE 4
  399. 7900  IF SECOND THEN 7990
  400. 7905  CLS:PRINT:PRINT TAB(10)"REMOVE NEW FILE DISK FROM DRIVE  B  AND INSERT BACKUP FILE DISK.":PRINT:PRINT TAB(10)"PRESS  F8  WHEN READY."
  401. 7910  SD$=INKEY$:IF SD$="@" THEN SECOND=1:GOTO 7470 ELSE 7910
  402. 7990  PRINT:PRINT TAB(10) "REMOVE BOTH DISKS":PRINT:PRINT TAB(10)"INSERT BOOKKEEPING FILE DISK IN DRIVE  B":PRINT:PRINT TAB(10)"INSERT NEW PAYROLL FILE DISK IN DRIVE  A":PRINT:PRINT TAB(10) "PRESS  F8  WHEN READY"
  403. 7995  ES$=INKEY$:IF ES$<>"@" THEN 7995 ELSE 50
  404. 8000  CLS:CLOSE 2:OPEN "A:DEDUCT.FIL" AS 2:FL$="DEDUCT.FIL":GOSUB 30210
  405. 8020  COLOR 0,7:LOCATE 25,1:PRINT "       ENTER ALL PERCENTAGES AS GIVEN NOT AS DECIMAL e.g. 12%=12   6.7%=6.7    ":COLOR 7,0:LOCATE 1,1
  406. 8030  PRINT TAB(7)"PAYROLL DEDUCTIONS FILE FOR WEEKLY PAYROLL---PERCENTAGE METHOD":PRINT:PRINT TAB(10)"C=CREATE FILE":PRINT:PRINT TAB(10)"R=READ, REVISE, OR PRINT FILE":PRINT:PRINT TAB(10)"O=PAYROLL OPTIONS":SKIP=0
  407. 8050  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="C" THEN 8080 ELSE IF X$="R" THEN 8760 ELSE IF X$="O" THEN 50 ELSE 8050
  408. 8080  IF LOF(2)/128>0 THEN COLOR 0,7:PRINT "    THIS FILE ALREADY EXISTS.  USE READ AND REVISE TO MAKE CHANGES.                    PRESS ANY KEY TO RETURN TO OPTIONS FOR FILE.  " ELSE 8090
  409. 8085  AK$=INKEY$:IF AK$="" THEN 8085 ELSE COLOR 7,0:CLS:GOTO 8020
  410. 8090  CLS:COLOR 0,7:LOCATE 25,1:PRINT "       ENTER ALL PERCENTAGES AS GIVEN NOT AS DECIMAL e.g. 12%=12   6.7%=6.7    ":COLOR 7,0:LOCATE 1,1
  411. 8100  PRINT TAB(10) "IF NO STATE TAX" SPC(40) "ENTER-----NONE":PRINT TAB(10) "IF STATE WITHHOLDING BASED ON FEDERAL WITHHOLDING      ENTER--FEDERAL":PRINT TAB(10) "IF STATE WITHHOLDING IS PERCENT OF GROSS INCOME        ENTER----GROSS"
  412. 8110  PRINT TAB(10) "IF PERCENT OF (GROSS INCOME-FED. ALLOW. PER DEPENDENT) ENTER---ADJUST":PRINT SPC(64);:INPUT STATE$:PRINT SPC(34);:INPUT "PERCENTAGE (IF NONE, ENTER 0)  ";STAT:IF SKIP%=1 THEN 8330
  413. 8150  CLS:COLOR 0,7:LOCATE 25,1:PRINT "       ENTER ALL PERCENTAGES AS GIVEN NOT AS DECIMAL e.g. 12%=12   6.7%=6.7    ":COLOR 7,0:LOCATE 1,1
  414. 8160  PRINT TAB(10) "IF NO CITY TAX" SPC(41) "ENTER-----NONE":PRINT TAB(10) "IF CITY WITHHOLDING BASED ON FEDERAL WITHHOLDING       ENTER--FEDERAL":PRINT TAB(10)"IF CITY WITHHOLDING BASED ON STATE WITHHOLDING         ENTER----STATE"
  415. 8170  PRINT TAB(10) "IF CITY WITHHOLDING IS PERCENT OF GROSS INCOME         ENTER----GROSS":PRINT TAB(10) "IF PERCENT OF (GROSS INCOME-FED. ALLOW. PER DEPENDENT) ENTER---ADJUST":PRINT SPC(64);:INPUT CITY$
  416. 8190  PRINT SPC(33);:INPUT "PERCENTAGE (IF NONE, ENTER 0)  ";CIT:IF SKIP%=2 THEN 8360
  417. 8210  FIELD 2, 8 AS A$, 10 AS B$:CLS:COLOR 0,7:LOCATE 25,1:PRINT "       ENTER ALL PERCENTAGES AS GIVEN NOT AS DECIMAL e.g. 12%=12   6.7%=6.7    ":COLOR 7,0:LOCATE 1,1
  418. 8230  PRINT SPC(44);:INPUT "FICA MAXIMUM INCOME ";MAX:PRINT SPC(37);:INPUT "EMPLOYEE'S FICA PERCENTAGE ";FIC:IF SKIP%=3 THEN 8390
  419. 8260  PRINT SPC(33);:INPUT "STATE UNEMPLOYMENT-MAX. INCOME ";SMAX:PRINT SPC(34);:INPUT "STATE UNEMPLOYMENT PERCENTAGE ";SUMP:IF SKIP%=4 THEN 8420
  420. 8290  PRINT SPC(31);:INPUT "FEDERAL UNEMPLOYEMENT PERCENTAGE ";FUMP:IF SKIP%=5 THEN 8450
  421. 8310  PRINT SPC(38);:INPUT "EMPLOYERS FICA PERCENTAGE ";EFIC:IF SKIP%=5 THEN 8450
  422. 8330  LSET A$=STATE$:LSET B$=MKD$(STAT):PUT 2,1:IF SKIP%=1 THEN 9320
  423. 8360  LSET A$=CITY$:LSET B$=MKD$(CIT):PUT 2,2:IF SKIP%=2 THEN 9320
  424. 8390  LSET A$=MKD$(FIC):LSET B$=MKD$(MAX):PUT 2,3:IF SKIP%=3 THEN 9320
  425. 8420  LSET A$=MKD$(SUMP):LSET B$=MKD$(SMAX):PUT 2,4:IF SKIP%=4 THEN 9320
  426. 8450  IF RV$="U" THEN LSET A$=MKD$(FUMP):GOTO 8460 ELSE IF RV$="E" THEN LSET B$=MKD$(EFIC):GOTO 8460 ELSE LSET A$=MKD$(FUMP):LSET B$=MKD$(EFIC)
  427. 8460  PUT 2, 5:IF SKIP%=5 THEN 9320
  428. 8470  CLS:COLOR 0,7:LOCATE 25,1:PRINT "       ENTER ALL PERCENTAGES AS GIVEN NOT AS DECIMAL e.g. 12%=12   6.7%=6.7    ":COLOR 7,0:LOCATE 1,1
  429. 8480  PRINT "INFORMATION FOR LAST SECTION IS OBTAINED FROM IRS FEDERAL EMPLOYERS TAX GUIDE---TABLES FOR PERCENTAGE METHOD WITHHOLDING."
  430. 8490  INPUT "FEDERAL WITHHOLDING ALLOWANCE PER DEPENDENT                                      (FROM EMPLOYERS TAX GUIDE - PERCENTAGE METHOD )";AL:FIELD 2, 8 AS A$:LSET A$=MKD$(AL):PUT 2,6:IF SKIP%=6 THEN 9320
  431. 8540  PRINT "FOR EACH RANGE YOU WILL NEED TO ENTER 4 ANSWERS SEPERATED BY COMMAS-------------LOW END OF RANGE, HIGH END, DOLLAR AMOUNT TO DEDUCT, PERCENTAGE TO DEDUCT.      IF NO LOW IS GIVEN, ENTER 0. IF NO HIGH IS GIVEN, ENTER 99999."
  432. 8550  PRINT "EXAMPLE--TABLE SAYS OVER $62 BUT NOT OVER $171      $4.20+16% OF EXCESS OVER $62----------ENTRY WOULD BE  62,171,4.20,16
  433. 8560  IF SKIP% THEN 9360
  434. 8570  PRINT:PRINT TAB(32) "SINGLE EMPLOYEE":FOR N=7 TO 14:PRINT "RANGE";:PRINT N-6;:INPUT "   ";LOW,HIGH,FED,FEDP:GOSUB 8670:NEXT:PRINT:PRINT TAB(31) "MARRIED EMPLOYEE":PRINT:FOR N=15 TO 22:PRINT "RANGE";:PRINT N-14;:INPUT "   ";LOW,HIGH,FED,FEDP
  435. 8650  GOSUB 8670:NEXT
  436. 8670  FIELD 2, 10 AS A$, 10 AS B$, 10 AS C$, 10 AS D$:LSET A$=MKD$(LOW):LSET B$=MKD$(HIGH):LSET C$=MKD$(FED):LSET D$=MKD$(FEDP):PUT 2,N:LOW=0:HIGH=0:FED=0:FEDP=0:IF SKIP% THEN 9320 ELSE 8030
  437. 8750  RETURN
  438. 8760  CLS:KEY(7) ON:ON KEY(7) GOSUB 9460:PRINT:PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10) "P=READ AND PRINT":DEF SEG=64:POKE 23, (PEEK(23) OR 64)
  439. 8800  PRT$=INKEY$:IF PRT$="P" OR PRT$="R" THEN CLS:GOTO 8810 ELSE 8800
  440. 8810  COLOR 0,7: PRINT "     PRESS   F8   TO READ RECORDS IN SEQUENCE. PRESS   F7  TO STOP AT ANY POINT. PRESS   F8  WHEN READY TO CONTINUE READING.":COLOR 7,0: PRINT:PRINT
  441. 8820  COLOR 0,7:PRINT " IF REVISING FILE, WRITE DOWN RECORD NUMBERS TO BE CHANGED. IF THERE IS A RECORD NO LONGER USED, IT CAN BE REPLACED BY USING ITS RECORD NUMBER FOR A NEW ENTRY": PRINT:PRINT: COLOR 7,0
  442. 8830  X$=INKEY$:IF X$<>"@" THEN 8830 ELSE DEF SEG:POKE 106,0
  443. 8850  PRINT "     PAYROLL DEDUCTIONS FILE FOR WEEKLY PAYROLL---PERCENTAGE METHOD":PRINT:IF PRT$="P" THEN LPRINT CHR$(27)CHR$(78)CHR$(6):LPRINT MODE$:LPRINT "     PAYROLL DEDUCTIONS FILE FOR WEEKLY PAYROLL---PERCENTAGE METHOD":LPRINT XMOD$
  444. 8870  FIELD 2, 8 AS A$, 10 AS B$:GET 2,1:PCT$="##.##%":PRINT "STATE TAX TYPE--"+A$+"        ";:PRINT USING PCT$;CVD(B$);:PRINT "    REC.NO. 1":IF PRT$="P" THEN LPRINT "STATE TAX TYPE--"+A$+"        ";:LPRINT USING PCT$;CVD(B$);:LPRINT "    REC.NO. 1"
  445. 8920  GET 2,2:PRINT "CITY TAX TYPE---"+A$+"        ";:PRINT USING PCT$;CVD(B$);:PRINT "    REC.NO. 2":IF PRT$="P" THEN LPRINT "CITY TAX TYPE---"+A$+"        ";:LPRINT USING PCT$;CVD(B$);:LPRINT "    REC.NO. 2"
  446. 8950  GET 2,3:PRINT "FICA MAX.INCOME-";:PRINT USING DL$;CVD(B$);:PRINT "     ";:PRINT USING PCT$;CVD(A$);:PRINT "    REC.NO. 3"
  447. 8970  IF PRT$="P" THEN LPRINT "FICA MAX.INCOME-";:LPRINT USING DL$;CVD(B$);:LPRINT "     ";:LPRINT USING PCT$;CVD(A$);:LPRINT "    REC.NO. 3"
  448. 8980  GET 2, 4
  449. 8990  PRINT"STATE UNEMP.MAX-";:PRINT USING DL$;CVD(B$);:PRINT "     ";:PRINT USING PCT$;CVD(A$);:PRINT"    REC.NO. 4":IF PRT$="P" THEN LPRINT"STATE UNEMP.MAX-";:LPRINT USING DL$;CVD(B$);:LPRINT"     ";:LPRINT USING PCT$;CVD(A$);:LPRINT"    REC.NO. 4"
  450. 9000  GET 2,5:PRINT "FED.UNEMP. RATE";:PRINT "                 ";:PRINT USING PCT$;CVD(A$);:PRINT "    REC.NO. 5":PRINT "EMPLOYERS FICA RATE             ";:PRINT USING PCT$;CVD(B$);:PRINT "    REC.NO. 5"
  451. 9020  IF PRT$="P" THEN LPRINT "FED.UNEMP. RATE";:LPRINT "                 ";:LPRINT USING PCT$;CVD(A$);:LPRINT "    REC.NO. 5":LPRINT "EMPLOYERS FICA RATE             ";:LPRINT USING PCT$;CVD(B$);:LPRINT "    REC.NO. 5"
  452. 9030  GET 2,6:PRINT "FED.WITH.ALLOW. PER DEPENDENT  ";:PRINT USING "$$##.##";CVD(A$);:PRINT "    REC.NO. 6":IF PRT$="P" THEN LPRINT "FED.WITH.ALLOW. PER DEPENDENT  ";:LPRINT USING "$$##.##";CVD(A$);:LPRINT "    REC.NO. 6"
  453. 9060  PRINT:PRINT TAB(20) "SINGLE EMPLOYEES TAX TABLE":PRINT:IF PRT$="P" THEN LPRINT MODE$:LPRINT TAB(20) "SINGLE EMPLOYEES TAX TABLE":LPRINT XMOD$
  454. 9080  PRINT TAB(16) "LOW       HIGH    DOLLAR AMT.    PERCENTAGE   REC.NO":PRINT:IF PRT$="P" THEN LPRINT TAB(16) "LOW       HIGH    DOLLAR AMT.    PERCENTAGE   REC.NO.":LPRINT
  455. 9100  FOR N=7 TO LOF(2)/128:FIELD 2, 10 AS A$, 10 AS B$, 10 AS C$, 10 AS D$:GET 2,N:IF N<>15 THEN 9170 ELSE PRINT:PRINT TAB(20) "MARRIED EMPLOYEES TAX TABLE":PRINT
  456. 9140  PRINT TAB(16) "LOW       HIGH    DOLLAR AMT.    PERCENTAGE   REC.NO":PRINT:IF PRT$="P" THEN LPRINT MODE$:LPRINT TAB(20) "MARRIED EMPLOYEES TAX TABLE":LPRINT XMOD$
  457. 9160  IF PRT$="P" THEN LPRINT TAB(16) "LOW       HIGH    DOLLAR AMT.    PERCENTAGE   REC.NO.":LPRINT
  458. 9170  IF N<15 THEN PRINT "RANGE";:PRINT N-6; ELSE PRINT "RANGE";:PRINT N-14;
  459. 9180  IF N<15 AND PRT$="P" THEN LPRINT "RANGE";:LPRINT N-6; ELSE IF PRT$="P" THEN LPRINT "RANGE";:LPRINT N-14;
  460. 9190  PRINT USING DL$;CVD(A$);CVD(B$);CVD(C$);:PRINT SPC(9) USING "##.##";CVD(D$);:PRINT SPC(7) N:IF PRT$="P" THEN LPRINT USING DL$;CVD(A$);CVD(B$);CVD(C$);:LPRINT SPC(9);:LPRINT USING "##.##";CVD(D$);:LPRINT SPC(7) N
  461. 9210  NEXT:KEY(7) OFF:IF PRT$="P" THEN LPRINT CHR$(12)
  462. 9230  PRINT:PRINT TAB(10) "R=REVISE FILE": PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS FOR THIS FILE"
  463. 9240  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="R" THEN 9270 ELSE IF X$="O" THEN CLS:PRINT:PRINT:GOTO 8030 ELSE 9240
  464. 9270  CLS:INPUT "  RECORD NUMBER TO BE REVISED";N:SKIP%=N:IF SKIP%<7 THEN FIELD 2, 8 AS A$, 10 AS B$
  465. 9300  IF N=1 THEN 8100 ELSE IF N=2 THEN 8160 ELSE IF N=3 THEN 8230 ELSE IF N=4 THEN 8260 ELSE IF N=5 THEN 9420 ELSE IF N=6 THEN 8490
  466. 9310  GOTO 8540
  467. 9320  PRINT:PRINT TAB(10) "R=REVISE ANOTHER":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS FOR THIS FILE"
  468. 9330  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="R" THEN 9270 ELSE IF X$="O" THEN 8030 ELSE 9330
  469. 9360  FIELD 2, 10 AS A$, 10 AS B$, 10 AS C$, 10 AS D$:GET 2, N:PRINT "REC.NO ";:PRINT N:PRINT TAB(7) "LOW       HIGH    DOLLAR AMT.    PERCENTAGE   REC.NO":PRINT
  470. 9390  PRINT USING DL$;CVD(A$);CVD(B$);CVD(C$);:PRINT SPC(9);:PRINT USING ".##";CVD(D$);:PRINT SPC(8) N:PRINT:INPUT "NEW---LOW,HIGH,DOLLAR AMT.TO DEDUCT,PERCENT TO DEDUCT (SEPARATED BY COMMAS)      ";LOW,HIGH,FED,FEDP:GOSUB 8670
  471. 9420  CLS:PRINT TAB(10) "U=REVISE FED. UNEMPLOYEMENT RATE":PRINT:PRINT TAB(10) "E=REVISE EMPLOYERS FICA RATE":GET 2,5
  472. 9440  RV$=INKEY$:IF RV$="U" THEN 8290 ELSE IF RV$="E" THEN 8310 ELSE 9440
  473. 9460  KEY(7) OFF:XZ$=INKEY$:IF XZ$=CHR$(27) THEN 50
  474. 9470  IF XZ$<>"@" THEN 9460 ELSE DEF SEG:POKE 106,0:KEY(7) ON:RETURN
  475. 20050  INPT$="":INPOS%=POS(0):DEF SEG=64:POKE 23, (PEEK(23) OR 64):POKE 23, (PEEK(23) OR 32):LOCATE,,1,6,7:IF INLN%=0 THEN INLN%=10
  476. 20110  IP$=INKEY$:IF IP$="" THEN 20110
  477. 20130  IF NBR THEN IF ASC(IP$)>57 THEN BEEP:GOTO 20110
  478. 20140  IF NBR THEN IF ASC(IP$)<48 AND ASC(IP$)<>46 AND ASC(IP$)<>45 THEN IF ASC(IP$)<>8 AND ASC(IP$)<>13 THEN BEEP:GOTO 20110
  479. 20150  IF ASC(IP$)=29 THEN BEEP:GOTO 20110
  480. 20155  IF ASC(IP$)=27 THEN 50
  481. 20160  IP$=CHR$(ASC(IP$)+32*(IP$>="a" AND IP$<="z")):IF LEN(INPT$)=INLN% THEN IF ASC(IP$)<>13 AND ASC(IP$)<>8 THEN 20110
  482. 20180  IF ASC(IP$)=13 THEN PRINT:GOTO 20240
  483. 20190  IF ASC(IP$)=8 AND POS(0)=INPOS% THEN 20110
  484. 20200  IF ASC(IP$)=8 THEN GOSUB 20250:GOTO 20110
  485. 20210  INPT$=INPT$+IP$:PRINT IP$;:GOTO 20110
  486. 20240  INLN%=0:RETURN
  487. 20250  IF INPT$="" THEN 20110
  488. 20260  INPT$=LEFT$(INPT$,LEN(INPT$)-1):LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:RETURN
  489. 30000  OPEN "BACKUP.FIL" AS 4:IF LOF(4)/128=0 THEN 30020 ELSE GOSUB 30070
  490. 30020  CLS:PRINT:PRINT TAB(10) "REMOVE DISK FROM DRIVE  A.":PRINT:PRINT TAB(10) "INSERT PROGRAM DISK IN DRIVE  A.":PRINT:PRINT TAB(10) "PRESS  F8  WHEN READY."
  491. 30030  X$=INKEY$:IF X$<>"@" THEN 30030
  492. 30050  RUN "EXPENSE.BAS"
  493. 30070  OPEN "P.BAT" FOR OUTPUT AS 3:FOR N=1 TO LOF(4)/128:FIELD 4, 14 AS A$:GET 4,N:IF LEFT$(A$,6)="CHKDSC" THEN CHKDSC=1:GOTO 30150
  494. 30140  PRINT #3, "COPY "+A$+" "+"B:"
  495. 30150  NEXT:PRINT #3, "COPY EMPLOYEE.CNT B:":PRINT #3, "COPY PAYROLL.TOT B:":IF CHKDSC THEN PRINT #3, "CHKDSK A:":PRINT #3, "CHKDSK B:"
  496. 30155  PRINT #3, "REM  REMOVE BOTH DISKS":PRINT #3, "REM  INSERT PROGRAM DISK IN DRIVE A":PRINT #3, "REM  ENTER  A  WHEN READY":CLOSE 3:CLOSE 4:KILL "BACKUP.FIL":RETURN
  497. 30210  IF BKUP THEN 30220 ELSE OPEN "BACKUP.FIL" AS 4:BKUP=1
  498. 30220  FIELD 4, 14 AS A$:SHORT=INSTR(FL$,CHR$(32)):IF SHORT>0 THEN FL$=LEFT$(FL$,SHORT-1)+RIGHT$(FL$,4)
  499. 30230  IF LOF(4)/128=0 THEN 30280
  500. 30240  FOR J=1 TO LOF(4)/128:GET 4,J:IF FL$+STRING$(14-LEN(FL$),32)=A$ OR LEFT$(A$,3)="*.*" THEN 30300
  501. 30270  NEXT
  502. 30280  LSET A$=FL$:PUT 4, LOF(4)/128+1
  503. 30300  RETURN
  504. 50000  CLS:GOTO 60000
  505. 50020  IF SHELLD%=1 THEN 50070
  506. 50030  DEF SEG=LD.ADDR:BLOAD "SHELLSRT",0:SHELLSRT=0:SHELLD%=1
  507. 50070  SEQ$="A":CLOSE 2:OPEN "EMPLOYEE.CNT" AS 2:FIELD 2, 46 AS AA$:COUNT%=LOF(2)/128:IF SHEELD% THEN 50120
  508. 50110  DIM DIRLST$(COUNT%)
  509. 50120  FOR N=1 TO COUNT%:GET 2,N:DIRLST$(N-1)=AA$:NEXT:DEF SEG=LD.ADDR:CALL SHELLSRT(SEQ$,COUNT%,DIRLST$(0)):FOR N=0 TO COUNT%-1:PRINT DIRLST$(N):LSET AA$=DIRLST$(N):PUT 2, N+1:NEXT:PRINT:PRINT TAB(10) "PRESS  F8  TO RETURN TO OPTIONS"
  510. 50240  MU$=INKEY$:IF MU$<>"@" THEN 50240 ELSE 50
  511. 59190  PRINT DIRLST$(N)
  512. 60000  TRUE%=-1:FALSE%=0:LDOUT%=FALSE%:GOSUB 60180:GOSUB 60230:GOSUB 60270:IF NOT LDOUT% THEN 60130
  513. 60030  GOSUB 60340:GOTO 60160
  514. 60050  '
  515. 60130  GOSUB 60380:CLEAR ,CLR.ADDR:GOSUB 60180:GOSUB 60430
  516. 60160  GOTO 50020
  517. 60170  END
  518. 60180  SUBR.SIZE=400:RETURN
  519. 60230  DEF SEG=0:SYS.MEMORY=PEEK(&H413)+PEEK(&H414)*256:RETURN
  520. 60270  DEF SEG=0:BASIC.DS=(PEEK(&H510)+PEEK(&H511)*256):OUTSIDE.BASIC.DS=BASIC.DS+4104+(SUBR.SIZE/16):IF OUTSIDE.BASIC.DS*16<SYS.MEMORY*1024 THEN LDOUT%=TRUE%
  521. 60330  RETURN
  522. 60340  LD.ADDR=OUTSIDE.BASIC.DS-(SUBR.SIZE/16):RETURN
  523. 60380  DEF SEG:TOP.STACK=PEEK(&H2C)+PEEK(&H2D)*256:CLR.ADDR=(TOP.STACK-SUBR.SIZE)-128:RETURN
  524. 60430  DEF SEG=0:BASIC.DS=16*(PEEK(&H510)+PEEK(&H511)*256):DEF SEG:TOP.STACK=PEEK(&H2C)+PEEK(&H2D)*256:LD.ADDR=(BASIC.DS+TOP.STACK)/16:LD.ADDR=INT(LD.ADDR+0.5):RETURN
  525.